Проникающая гидроизоляция бетона
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Не переопределяется значение размера в блоке (VBA, AutoCad 2014)

Не переопределяется значение размера в блоке (VBA, AutoCad 2014)

Ответ
Поиск в этой теме
Непрочитано 18.09.2016, 12:07 #1
Не переопределяется значение размера в блоке (VBA, AutoCad 2014)
Linkor
 
что хочу, то и делаю
 
Регистрация: 30.06.2014
Сообщений: 118

Здравствуйте! Может кто то сталкивался с такой проблемой: создаю блок, туда заношу (рисую) размер. Мне нужно воспользоваться свойством TextOverride. Ошибок не возникает, всё выполняется. Но при вставке блока переопределенное значение размера не отображается. Только если зайти в блок через редактор, то там показывается правильное значение. В чём может быть причина?
Просмотров: 2009
 
Непрочитано 18.09.2016, 13:03
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 6,996


с выложенным примером помощь приходит быстрее обычно)
Сергей812 вне форума  
 
Автор темы   Непрочитано 18.09.2016, 16:38
#3
Linkor

что хочу, то и делаю
 
Регистрация: 30.06.2014
Сообщений: 118


Вот две процедуры, после выполнения которых вставляем блок через окно автокада с неправильным размером. Если зайти в блок через редактор, то размер отобразиться правильно
Код:
[Выделить все]
Sub CreateBlk()
Dim blk As AcadBlock
Dim sp(0 To 2) As Double
Dim ep(0 To 2) As Double
Dim ipoint(0 To 2) As Double
Dim obj As AcadEntity
      sp(1) = 5
      ep(1) = 25
      On Error Resume Next
      Set blk = ThisDrawing.Blocks.Add(ipoint, "Пример")
      If Err <> 0 Then
            Set blk = ThisDrawing.Blocks("Пример")
            For Each obj In blk
                  obj.Delete
            Next obj
      End If
      blk.AddLine sp, ep
      DimRotDrawing1 (blk.Name)
End Sub

    
Sub DimRotDrawing1(blkName As String)
'dLen - В единицах листа
Dim sp
Dim ep
Dim loc(0 To 2) As Double
Dim objDim As AcadDimRotated
Dim blk As AcadBlock
Dim objline As AcadLine
Dim obj As AcadEntity


      Set blk = ThisDrawing.Blocks(blkName)
      

            
            If ep(0) = sp(0) Then
                  If ep(1) > sp(1) Then alf = Pi / 2 Else alf = 3 * Pi / 2
            Else
                  koeff = (ep(1) - sp(1)) / (ep(0) - sp(0))
                  alf = Atn(koeff)
                  If ep(0) > sp(0) Then alf = 0 Else alf = Pi
            End If

            loc(0) = (sp(0) + ep(0)) / 2 + (DimBase + dLen) * DimScale * Cos(alf - Pi / 2): ' dimloc(1) = sp(0) + koeff*()-DimBase * DimScale
            loc(1) = (sp(1) + ep(1)) / 2 + (DimBase + dLen) * DimScale * Sin(alf - Pi / 2)
            alf = alf + dRot
            
            Set objDim = blk.AddDimRotated(sp, ep, loc, alf)
            objDim.TextOverride = "d=<>" 'не отображается

End Sub
Linkor вне форума  
 
Непрочитано 19.09.2016, 06:05
1 | #4
Владимир_М


 
Регистрация: 05.11.2015
Сообщений: 585


Кажется, подобный вопрос уже задавал. Может так?
http://forum.dwg.ru/showpost.php?p=1519068&postcount=10
мне помогло
Владимир_М вне форума  
 
Непрочитано 19.09.2016, 09:03
1 | #5
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,754


Linkor, ты ради интересу в модуль вбей Option Explicit, да проверь видимость переменных. Массу интересного углядишь.
Чему равно pi? Откуда DimBase? dLen? dRot? Почему у тебя в DimRotDrawing1 используются локальные значения sp и ep? alf не объявлена, необходимости в переменной koeff чуть меньше чем нет совсем, да и вообще в строках
Код:
[Выделить все]
koeff = (ep(1) - sp(1)) / (ep(0) - sp(0))
alf = Atn(koeff)
я смысла не вижу: ты потом все равно переопределяешь alf, наплевав на все вычисления.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2016, 10:19
#6
Linkor

что хочу, то и делаю
 
Регистрация: 30.06.2014
Сообщений: 118


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Чему равно pi? Откуда DimBase? dLen? dRot?
Модуль гораздо больше, тут много лишнего удалено (и неудачно), а нужное не добавлено. Исправляюсь
Код:
[Выделить все]
Sub CreateBlk()
Dim blk As AcadBlock
Dim sp(0 To 2) As Double
Dim ep(0 To 2) As Double
Dim ipoint(0 To 2) As Double
Dim obj As AcadEntity
      sp(1) = 5
      ep(1) = 25
      On Error Resume Next
      Set blk = ThisDrawing.Blocks("Пример")
      If Err = 0 Then
            For Each obj In blk
                  obj.Delete
            Next obj
      End If
      Set blk = ThisDrawing.Blocks.Add(ipoint, "Пример")
      blk.AddLine sp, ep
      DimRotDrawing1 (blk.name)
End Sub

    
Sub DimRotDrawing1(blkName As String)
'dLen - В единицах листа
Dim sp
Dim ep
Dim loc(0 To 2) As Double
Dim objDim As AcadDimRotated
Dim blk As AcadBlock
Dim objline As AcadLine
Dim obj As AcadEntity
Const DimBase = 8
Const Pi = 3.14159265358979

      Set blk = ThisDrawing.Blocks(blkName)
      
            DimScale = 2
            sp = blk.Item(0).StartPoint
            ep = blk.Item(0).EndPoint
            If ep(0) = sp(0) Then
                  If ep(1) > sp(1) Then alf = Pi / 2 Else alf = 3 * Pi / 2
            Else
                  koeff = (ep(1) - sp(1)) / (ep(0) - sp(0))
                  alf = Atn(koeff)
                  If koeff = 0 Then
                        If ep(0) > sp(0) Then alf = 0 Else alf = Pi
                  End If
            End If

            loc(0) = (sp(0) + ep(0)) / 2 + DimBase * DimScale * Cos(alf - Pi / 2):
            loc(1) = (sp(1) + ep(1)) / 2 + DimBase * DimScale * Sin(alf - Pi / 2)
            
            
            Set objDim = blk.AddDimRotated(sp, ep, loc, alf)
            objDim.TextOverride = "d=<>" 'не отображается

End Sub
Linkor вне форума  
 
Непрочитано 19.09.2016, 10:21
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,754


Специально для 2013 поставил VBA. Действительно, не переопределяется.
Тогда для таких случаев придется использовать CopyObjects.

----- добавлено через ~1 мин. -----
Мой вариант кода:
Код:
[Выделить все]
Option Explicit
Option Base 0

Public Const Pi = 3.14159265358979

Public Sub dwgCreateBlock()
Dim oBlockDefinition As AcadBlock
Dim oDimRot As AcadDimRotated
Dim ptStart(2) As Double, ptEnd(2) As Double, ptBase(2) As Double, ptMid(2) As Double
Dim sBlockName As String
Dim dDist As Double, dAngle As Double
  ThisDrawing.PurgeAll
  sBlockName = "test"
  ptStart(0) = 0#: ptStart(1) = 0#
  ptEnd(0) = 0#: ptEnd(1) = 10#
  ptBase(0) = 0#: ptBase(1) = 0#
  On Error GoTo lExit
  Set oBlockDefinition = ThisDrawing.Blocks.Add(ptBase, sBlockName)
  oBlockDefinition.AddLine ptStart, ptEnd
  dDist = 10#
  Select Case True
    Case ptStart(0) = ptEnd(0)
      If ptEnd(1) > ptStart(1) Then
        dAngle = Pi * 0.5
      Else
        dAngle = Pi * 1.5
      End If
    Case ptStart(0) > ptEnd(0)
      dAngle = 0#
    Case ptStart(0) < ptEnd(0)
      dAngle = Pi
  End Select
  ptMid(0) = (ptStart(0) + ptEnd(0)) * 0.5
  ptMid(1) = (ptStart(1) + ptEnd(1)) * 0.5
  Set oDimRot = oBlockDefinition.AddDimRotated(ptStart, ptEnd, ThisDrawing.Utility.PolarPoint(ptMid, dAngle - Pi * 0.5, dDist), dAngle)
  oDimRot.TextOverride = "d=<>"
  oDimRot.Update
lExit:
End Sub
Пробовал не особо тщательно, так что по поводу ошибок и некорректной работы прошу не пинать.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.09.2016, 10:47
#8
Linkor

что хочу, то и делаю
 
Регистрация: 30.06.2014
Сообщений: 118


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Тогда для таких случаев придется использовать CopyObjects.
Да, это помогло
Linkor вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Не переопределяется значение размера в блоке (VBA, AutoCad 2014)

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не находит команду Flatten в AutoCAD 2014 rtyu AutoCAD 3 11.07.2014 09:26
Отображение выбора в Autocad 2015 как в Autocad 2014 aso3 AutoCAD 2 19.06.2014 09:21
AutoCAD 2014+Raster Design 2014. Постоянная прединсталляция при запуске обычным пользователем! Westroy AutoCAD 4 14.05.2014 10:27
Как открыть файл в AutoCAD Structural Detailing 2014 Andreyweb Вертикальные решения на базе AutoCAD 1 05.07.2013 12:27