Сообщество программистов Autodesk в СНГ

ADN Club => VBA => Тема начата: DMA от 05-02-2019, 20:25:37

Название: Прошу помощи с кодом. VBA
Отправлено: DMA от 05-02-2019, 20:25:37
Здравствуйте, помогите найти косяк в коде.
Требуется написать проверку совпадения точек поли-линий чертежа с точками простановки размеров. Уже голову себе сломал, от танцев с бубнами.
1. Решил собрать handlers для всех выделенных объектов.
2. Потом на всем пространстве модели выбираю и записываю массив handler-ов всех полилиний. (чтобы потом отбросить лишние)
3. Затем выбираю все размеры...
4...
Вот на пункте 3,- автокад решительно отказывается что-либо находить...
Подскажите, плиз. Что не так?
Целый день копал интернет ничего не накопал :(((

Код - Visual Basic [Выбрать]
  1. Public Sub razmcheck()
  2.  
  3.   Dim sset As AcadSelectionSet
  4.   Dim i As Integer
  5.   Dim entry As AcadEntity
  6.   Dim hand1(0 To 1000) As String
  7.   Dim hand2(0 To 1000) As String
  8.   Dim hand3(0 To 1000) As String
  9.   Set sset = ThisDrawing.SelectionSets.Add("s1")
  10.   sset.SelectOnScreen
  11.   i = 0
  12.   MsgBox "ðàçìåðíîñòü ìàññèâà: " & sset.Count
  13.   For Each entry In sset
  14.     hand1(i) = entry.handle
  15.     i = i + 1
  16.   Next entry
  17.   sset.Delete
  18.  
  19.     Dim Fil2Type(0) As Integer
  20.     Dim Fil2Data(0) As Variant
  21.     Dim sset2 As AcadSelectionSet
  22.     Set sset2 = ThisDrawing.SelectionSets.Add("b111")
  23.     Fil2Type(0) = 0
  24.     Fil2Data(0) = "LWPolyline"
  25.     sset2.Select acSelectionSetAll, , , Fil2Type, Fil2Data
  26.     MsgBox "ïîëèëèíèé=" & sset2.Count
  27.      i = 0
  28.      For Each entry In sset2
  29.      hand2(i) = entry.handle
  30.      i = i + 1
  31.      Next entry
  32.      sset2.Delete
  33.    
  34.    
  35.    
  36.        
  37.  
  38.     Dim Dset3 As AcadSelectionSet
  39.     Dim Fil3Type(4) As Integer
  40.     Dim Fil3Data(4) As Variant
  41.     Set Dset3 = ThisDrawing.SelectionSets.Add("a1122w")
  42.     Fil3Type(0) = 0: Fil3Type(1) = 0: Fil3Type(2) = 0: Fil3Type(3) = 0: Fil3Type(4) = 0
  43.     Fil3Data(0) = "DimAligned": Fil3Data(1) = "DimOrdinate": Fil3Data(2) = "DimAngular": Fil3Data(3) = "DimDiametric": Fil3Data(4) = "DimRotated"
  44.     Dset3.Select acSelectionSetAll, , , Fil3Type, Fil3Data
  45.     MsgBox "ðàçìåðîâ=" & Dset3.Count
  46.      i = 0
  47.      For Each entry In Dset3
  48.      hand3(i) = entry.handle
  49.      i = i + 1
  50.      MsgBox "êîë-âî=" & i
  51.      Next entry
  52.      Dset3.Delete
  53.  
  54. End Sub
  55.  

Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 05-02-2019, 20:39:38
Фильтруй по "DIMENSION"
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 05-02-2019, 20:43:47
Ура!!!
Спасибо большое. Я уже был близок к верному решению путем перебора вариантов :)))
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 05-02-2019, 20:45:56
DMA,
Прочитай у меня в подписи о форматировании кода на форуме.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Владимир Шу от 05-02-2019, 22:18:14
DMA, добавлю только: чтобы в публикуемом коде кириллица нормально вставлялась, копировать код в буфер обмена нужно при включенной русской раскладке клавиатуры.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 05-02-2019, 22:19:34
спасибо за полезное замечание. В будущем учту.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 08-02-2019, 15:47:34
Не найдя для себя приемлемого способа получения из размеров точек привязки размерных линий (из пары решений найденных одно не подошло, с другим не смог разобраться), решил действовать так:
1. Скопировать размер.
2. Изменить стиль размера убрав стрелки.
3. взорвать его
4. проанализировать останки и найти точки привязки (они на свободных концах отрезков)
5. удалить оставшееся.

Столкнулся с тем что не могу изменить стиль размера. И вообще похоже не могу обратиться к нему.
я передаю в функцию его handler и через Set привязываю его к переменной. И вот какой бы тип переменной я не поставил автокаду это не нравится...
Кода с собой нет, показать не могу, но возможно и так будет понятно...
Изначальный размер- это параллельный размер.

И еще как можно более тонко отфильтровать размер? DIMENSIONS же сгребает все размеры в кучу?
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Владимир Шу от 08-02-2019, 16:08:00
на dwg не так давно была похожая тема, посмотрите, может поможет: ссылка (http://forum.dwg.ru/showpost.php?p=1780444&postcount=4)
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 08-02-2019, 17:42:59
Цитата: DMA от 08-02-2019, 15:47:34
Кода с собой нет, показать не могу, но возможно и так будет понятно...
Нет. Без кода - гадание на кофейной гуще.
Цитата: DMA от 08-02-2019, 15:47:34
И еще как можно более тонко отфильтровать размер? DIMENSIONS же сгребает все размеры в кучу?
Можно отфильтровать точнее. Прочитай в DXF для DIMENSION описание группы 70: https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2017/ENU/AutoCAD-DXF/files/GUID-EDD54EAC-A339-4EBA-AEA6-EC8066505E2B-htm.html (https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2017/ENU/AutoCAD-DXF/files/GUID-EDD54EAC-A339-4EBA-AEA6-EC8066505E2B-htm.html)
Цитировать
70
Dimension type:
Values 0-6 are integer values that represent the dimension type. Values 32, 64, and 128 are bit values, which are added to the integer values (value 32 is always set in R13 and later releases)
0 = Rotated, horizontal, or vertical
1 = Aligned
2 = Angular
3 = Diameter
4 = Radius
5 = Angular 3-point
6 = Ordinate
32 = Indicates that the block reference (group code 2) is referenced by this dimension only
64 = Ordinate type. This is a bit value (bit 7) used only with integer value 6. If set, ordinate is X-type; if not set, ordinate is Y-type
128 = This is a bit value ( bit 8 ) added to the other group 70 values if the dimension text has been positioned at a user-defined location rather than at the default location
Ну и соответственно фильтр:
Код - Visual Basic [Выбрать]
  1. Dim FilType(3) As Integer
  2. Dim FilData(3) As Variant
  3. FilType(0) = 0 : FilType(1) = -4 : FilType(2) = 70  
  4. FilData(0) = "DIMENSION" : FilData(1) = "&" : FilData(2) = 1
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 08-02-2019, 22:17:11
Цитата: Александр Ривилис от 08-02-2019, 17:42:59
Нет. Без кода - гадание на кофейной гуще.

Код - Visual Basic [Выбрать]
  1.  ' копируем массив с размерами для последующего лута
  2.    Dim copyObj(0 To 1000) As AcadObject
  3.     Dim midObj As AcadObject
  4.     Dim copyhand1(0 To 1000) As String
  5.     Dim retObj As AcadObject
  6.     Dim APnts(0 To 3) As Variant
  7.     MsgBox ("циклов:") & f
  8.     For i = 0 To f
  9.     Set midObj = ThisDrawing.HandleToObject(hand3(i))
  10.     Set retObj = midObj.Copy
  11.     copyhand1(i) = retObj.Handle
  12.     Next i
  13.     KILLandLOOT copyhand1(0), APnts()
  14.  
  15.  
  16. End Sub
  17.  
  18. Public Function KILLandLOOT(mass As String, alpha As Variant)
  19.     Dim dim1Obj As Variant
  20.     Set dim1Obj = ThisDrawing.HandleToObject(mass)
  21.     dimObj.Arrowhead1Type = acArrowBoxBlank
  22.     dimObj.Arrowhead1Type = acArrowBoxBlank
  23.  
  24. End Function

При этом Handlу от параллельного размера...
Как я понял, ему не нравится либо тип dim1Obj (перебирал уже), либо не правильно задаю соответствие Set. А как правильно задать не понимаю. :(
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 08-02-2019, 23:11:42
Цитата: Владимир Шу от 08-02-2019, 16:08:00
на dwg не так давно была похожая тема, посмотрите, может поможет: ссылка

Спасибо большое, посмотрю.
Единственно мне интересно уже свой способ добить тоже.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 09-02-2019, 00:07:00
Цитата: DMA от 08-02-2019, 22:17:11
Dim dim1Obj As Variant
Почему?
Скорее уж AcadObject, или один из классов размеров: Dim3PointAngular, DimAligned, DimAngular, DimArcLength, DimDiametric, DimRotated
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 09-02-2019, 01:05:26
Цитата: Александр Ривилис от 09-02-2019, 00:07:00
Почему?
Скорее уж AcadObject, или один из классов размеров: Dim3PointAngular, DimAligned, DimAngular, DimArcLength, DimDiametric, DimRotated

Не работает. Еще раз переподставил все предложенное.
Команда: ; ошибка: Ошибка Automation. Не удалось запустить макрос VBA
обламывается на SET
а variant я ставил уже от безысходности, просто попробовать...

-- заметил еще что если dim1Obj определе НЕ как AcadObject, то сыпется все чуть раньше,- на входе.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 09-02-2019, 01:23:06
Тем не менее такая конструкция должна работать при корректном handle:
Код - Visual Basic [Выбрать]
  1.     Dim tempObj As AcadObject
  2.     Set tempObj = ThisDrawing.HandleToObject(handle)
В противном случае это или баг в конкретной версии или проблема с твоим AutoCAD / Windows
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 09-02-2019, 01:52:41
DMA,
А тут я вообще не понял:
Код - Visual Basic [Выбрать]
  1. Set dim1Obj = ThisDrawing.HandleToObject(mass)
  2. dimObj.Arrowhead1Type = acArrowBoxBlank
В одном месте dim1Obj, а в другом dimObj
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 09-02-2019, 02:06:51
Цитата: Александр Ривилис от 09-02-2019, 01:52:41
В одном месте dim1Obj, а в другом dimObj
да Ё-моё... исправил все. работает.
Спасибо Александр большое.
Сажусь после работы за комп, концентрация совсем никуда...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 10-02-2019, 03:20:19
Код - Visual Basic [Выбрать]
  1. Public Function KILLandLOOT(mass1 As String, alpha As Variant)
  2.     Dim dim1Obj As AcadObject
  3.     Dim midObj As AcadObject
  4.     Dim i As Integer
  5.    
  6.     Set midObj = ThisDrawing.HandleToObject(mass1)
  7.     Set dim1Obj = midObj.Copy
  8.     dim1Obj.Arrowhead1Type = acArrowBoxBlank: dim1Obj.Arrowhead2Type = acArrowBoxBlank
  9.     dim1Obj.Color = acRed
  10.     dim1Obj.ExtensionLineOffset = 0: dim1Obj.ArrowheadSize = 0: dim1Obj.ExtensionLineExtend = 0
  11.  
  12.     Dim expObj As Variant
  13.     expObj = dim1Obj.Explode
  14.   ' Проходим по взорванному объекту, отображая
  15.  ' тип каждого полученного объекта другим цветом
  16.    For i = 0 To UBound(expObj)
  17.     expObj(i).Color = acRed
  18.     expObj(i).Update
  19.     MsgBox "Тип объекта " & i & ": " & expObj(i).ObjectName
  20.     expObj(i).Color = acByLayer
  21.     expObj(i).Update
  22.   Next
  23. End Function



1. Александр, не подскажете почему не работает explode применительно к размерам?
И 2. Дайте ссылку на какой-нибудь ресурс где можно по vba что-нибудь прочитать. А то уже неудобно дергать вас глупыми вопросами.

Я так понял explode не работает с AcadObject?
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 10-02-2019, 14:49:41
Цитата: DMA от 10-02-2019, 03:20:19
1. Александр, не подскажете почему не работает explode применительно к размерам?
Увы, но в очередной раз мы попадаем на ограничение VBA в AutoCAD. Только для этих типов объектов есть метод Explode:
(https://farm8.staticflickr.com/7875/40082395253_3cc8790be9_o.png)
P.S.: Рекомендую побыстрее забыть про VBA и перейти на .NET (лучше C#) для AutoCAD

Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 10-02-2019, 15:03:42
Вот так можно расчленить размер:
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Sub XplodeDims()
  4.  
  5. Dim objDim As AcadEntity
  6. Dim pt As AcadPoint
  7. Dim strCmd As String
  8.  
  9. strCmd = "_Explode" & vbCr
  10.  
  11. On Error Resume Next
  12. Utility.GetEntity objDim, pt, "Выберите размер"
  13.  
  14. If Err.Number <> -2147352567 Then
  15.  
  16.   If InStr(1, TypeName(objDim), "IAcadDim") = 0 Then
  17.    ' Это не размер
  18.   MsgBox "Это не размер!", vbCritical
  19.   Else
  20.    strCmd = strCmd & "(handent " & Chr(34)
  21.    strCmd = strCmd & objDim.Handle & Chr(34)
  22.    strCmd = strCmd & ")" & vbCr
  23.   End If
  24.  
  25. End If
  26.  
  27. On Error GoTo 0
  28. ' Находим последний элемент до расчленения
  29. Dim nLastEnt As Integer
  30. nLastEnt = ThisDrawing.ModelSpace.Count - 1
  31.  
  32. ' Запускаем _EXPLODE
  33. SendCommand strCmd & vbCr
  34.  
  35. ' Находим последний элемент после расчленения
  36. Dim nLastEntNew As Integer
  37. nLastEntNew = ThisDrawing.ModelSpace.Count - 1
  38.  
  39. MsgBox ("Новых элементов: " & CStr(nLastEntNew - nLastEnt + 1))
  40.  
  41. Dim i As Integer
  42.  
  43. For i = nLastEnt To nLastEntNew
  44.   ' Очередной расчленённый объект
  45.  MsgBox (ThisDrawing.ModelSpace.Item(i).ObjectName)
  46. Next
  47. End Sub
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Владимир Шу от 10-02-2019, 17:55:07
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 10-02-2019, 17:57:49
Цитата: Владимир Шу от 10-02-2019, 17:55:07
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.
Лучше всего вообще не пользоваться VBA. Смещение хендла в разных версиях AutoCAD (а возможно и внутри) одной может быть разным. А если чертеж пришел (не дай Бог) из какого-то клона AutoCAD, то может быть совсем печально...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 10-02-2019, 18:42:58
Цитата: Владимир Шу от 10-02-2019, 17:55:07
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Кстати, блок взрывать не нужно (и невозможно) - это же не INSERT, а BLOCK. По нему можно просто пройтись итератором.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Владимир Шу от 10-02-2019, 19:29:23
Цитата: Александр Ривилис от 10-02-2019, 18:42:58
Кстати, блок взрывать не нужно (и невозможно) - это же не INSERT, а BLOCK. По нему можно просто пройтись итератором.
ну я примерно на это и намекал в 7 сообщении...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 10-02-2019, 22:25:55
Цитата: Александр Ривилис от 10-02-2019, 14:49:41
P.S.: Рекомендую побыстрее забыть про VBA и перейти на .NET (лучше C#) для AutoCAD

Да, я уже склоняюсь потихоньку к такому выводу. Вот только думал, что вместо С# будет Piton (у меня светит впереди еще необходимость разбираться с Рино грасхоппером, а там питон), но  не суть. Может параллельно будет Питон с C#. Самое главное сколько будет времени свободного.

Вот в сети нарыл системную переменную DIMASSOC=0 (при 0 вставляет размер взорванным) , но как ее прикрутить к программе и возможно ли это вообще не понял пока.
Но в целом я так примерно и думал в направлении запуска внешней команды, единственно долго бы тупил, без подсказки, как это правильно оформить :)
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 10-02-2019, 22:28:46
Цитата: Владимир Шу от 10-02-2019, 17:55:07
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.
для меня это наверное пока рановато. Идея в принципе понятна, но я вязну на раз два в особенностях автокада (+ совсем начальные знания по vba)...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 00:12:20
Цитата: DMA от 10-02-2019, 22:25:55
Вот в сети нарыл системную переменную DIMASSOC=0 (при 0 вставляет размер взорванным) , но как ее прикрутить к программе и возможно ли это вообще не понял пока.
Размеры у тебя уже вставлены, так что никакая системная переменная на них не повлияет.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 01:14:30
Цитата: Александр Ривилис от 10-02-2019, 15:03:42
Вот так можно расчленить размер:
Спасибо, размеры взрываются, единственно автокад считает что после взрыва добавлен только один элемент (в моем случае это AcDbAlignedDimension) хотя все в модели взорвано на кусочки...

Цитата: Александр Ривилис от 11-02-2019, 00:12:20
Размеры у тебя уже вставлены, так что никакая системная переменная на них не повлияет.
а если скопировать размер с этой системной переменной=0 , так не получится (это уже чисто ради интереса)?
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 01:19:15
Цитата: DMA от 11-02-2019, 01:14:30
Спасибо, размеры взрываются, единственно автокад считает что после взрыва добавлен только один элемент (в моем случае это AcDbAlignedDimension) хотя все в модели взорвано на кусочки...
Ты проверял с моим кодом? Размеры у тебя в модели или в листе? Если в листе, то вместо modelspace должно быть paperspace.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 01:20:57
Цитата: DMA от 11-02-2019, 01:14:30
а если скопировать размер с этой системной переменной=0 , так не получится (это уже чисто ради интереса)?
Нет конечно. Эта системная переменная влияет только на создание размеров командой AutoCAD.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 01:35:44
Цитата: Александр Ривилис от 11-02-2019, 01:19:15
Ты проверял с моим кодом? Размеры у тебя в модели или в листе? Если в листе, то вместо modelspace должно быть paperspace.
да, проверял с Вашим кодом. Размеры в модели.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 01:47:43
DMA,
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 01:51:37
Цитата: Александр Ривилис от 11-02-2019, 01:47:43
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
F.205.0.0 Autocad 2012 russian sp2
чертеж абсолютно пустой, проставляю размер в пустоту и запускаю макрос.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 10:15:46
Цитата: DMA от 11-02-2019, 01:51:37
Цитата: Александр Ривилис от 11-02-2019, 01:47:43
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
F.205.0.0 Autocad 2012 russian sp2
чертеж абсолютно пустой, проставляю размер в пустоту и запускаю макрос.
Специально проверил в AutoCAD 2012 SP2 (у меня английский, но это не должно влиять). Всё работает как надо:


Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 10:32:21
Еще раз перепроверил на рабочем компьютере, здесь тоже 2012. Не работает.
В чем Вы , кстати, видео записываете?
Есть ли сервайс пак 3 на 2012 интересно?
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 10:33:58
Цитата: DMA от 11-02-2019, 10:32:21
В чем Вы , кстати, видео записываете?
Прочитай у меня в подписи.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 10:38:29
Проверил в 2015, тоже не работает.
Вряд ли это некорректная работа обеих версий. Тут видимо что-то еще...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 10:46:29
Цитата: Александр Ривилис от 11-02-2019, 10:33:58
Прочитай у меня в подписи.
если нужно, вечером запишу и отправлю.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 12:49:08
Цитата: DMA от 11-02-2019, 10:46:29
Цитата: Александр Ривилис от 11-02-2019, 10:33:58
Прочитай у меня в подписи.
если нужно, вечером запишу и отправлю.
Не помешает понять что у тебя происходит. Возможно взаимодействие с какими-то другими программами. Я проверил даже в древнем AutoCAD 2008 - всё работает. Немного модифицировал код, так как похоже у тебя не завершается команда EXPLODE до того как отрабатывает дальнейший код.

Код - Visual Basic [Выбрать]
  1.     Option Explicit
  2.      
  3.     Sub XplodeDims()
  4.      
  5.         Dim objDim As AcadEntity
  6.         Dim pt As AcadPoint
  7.         Dim strCmd As String
  8.          
  9.         strCmd = "_.Explode" & vbCr
  10.          
  11.         On Error Resume Next
  12.        
  13.         ThisDrawing.Utility.GetEntity objDim, pt, "Выберите размер"
  14.          
  15.         If Err.Number <> -2147352567 Then
  16.          
  17.           If InStr(1, TypeName(objDim), "IAcadDim") = 0 Then
  18.            ' Это не размер
  19.           MsgBox "Это не размер!", vbCritical
  20.           Else
  21.            strCmd = strCmd & "(handent " & Chr(34)
  22.            strCmd = strCmd & objDim.Handle & Chr(34)
  23.            strCmd = strCmd & ")" & vbCr
  24.           End If
  25.          
  26.         End If
  27.          
  28.         On Error GoTo 0
  29.         ' Находим последний элемент до расчленения
  30.        Dim nLastEnt As Integer
  31.         nLastEnt = ThisDrawing.ModelSpace.Count - 1
  32.          
  33.         ' Запускаем _EXPLODE
  34.        ThisDrawing.SendCommand strCmd
  35.         ' Выполняем до завершения команды
  36.        While ThisDrawing.GetVariable("CMDNAMES") = "EXPLODE"
  37.           ThisDrawing.SendCommand vbCr
  38.         Wend
  39.        
  40.          
  41.         ' Находим последний элемент после расчленения
  42.        Dim nLastEntNew As Integer
  43.         nLastEntNew = ThisDrawing.ModelSpace.Count - 1
  44.          
  45.         MsgBox ("Новых элементов: " & CStr(nLastEntNew - nLastEnt + 1))
  46.          
  47.         Dim i As Integer
  48.          
  49.         For i = nLastEnt To nLastEntNew
  50.           ' Очередной расчленённый объект
  51.          MsgBox (ThisDrawing.ModelSpace.Item(i).ObjectName)
  52.         Next
  53.     End Sub
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 14:14:04
нет, тоже самое. + в конце выбор еще одного размера для разбивки без вывода информации...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Дмитрий Загорулькин от 11-02-2019, 14:43:33
Цитата: Александр Ривилис от 11-02-2019, 12:49:08
Я проверил даже в древнем AutoCAD 2008 - всё работает.
Проверил в AutoCAD as Civil 3D 2014 - работает. Видео:
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 14:49:15
Цитата: Дмитрий Загорулькин от 11-02-2019, 14:43:33
Проверил в AutoCAD as Civil 3D 2014 - работает.
ё-моё, почему интересно у меня-то не хочет. Вечером еще до 2-х компов с Автокадом дойду, попробую.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 17:21:19
в 2018-ом работает правильно...
на той же машине где 2012,2015
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 17:26:28
Цитата: DMA от 11-02-2019, 17:21:19
в 2018-ом работает правильно...
на той же машине где 2012,2015
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся. Например, какие-то установленные приложения к AutoCAD.
Или нестандартное состояние системных переменных.
Можно попробовать создать новый профиль AutoCAD, переключится на него, выполнить его сброс и проверить код.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 20:13:40
Цитата: Александр Ривилис от 11-02-2019, 17:26:28
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся.
при экспортировании в Автокад 2018 панелек с кнопками макросов, через какое-то время (или сразу) , перестал работать данный код :)))
сброс настроек профиля ни к чему не привел  (хотя я возможно сделал не то что нужно).
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 11-02-2019, 20:47:14
Цитата: DMA от 11-02-2019, 20:13:40
Цитата: Александр Ривилис от 11-02-2019, 17:26:28
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся.
при экспортировании в Автокад 2018 панелек с кнопками макросов, через какое-то время (или сразу) , перестал работать данный код :)))
сброс настроек профиля ни к чему не привел  (хотя я возможно сделал не то что нужно).

Ну теперь становится ясно, что проблема в этих панельках.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 11-02-2019, 22:18:28
Цитата: Александр Ривилис от 11-02-2019, 20:47:14
Ну теперь становится ясно, что проблема в этих панельках.
как появится время попробую выяснить конкретнее, что является причиной такого поведения автокада...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 12-02-2019, 22:23:11
Локализовал причину.
Макрос запускался через найденный в интернете кусок кода на LISPe. Вот что значит использовать то, что до конца не понимаешь как работает :))
Прошу прощения , что напряг народ очередной глупостью...

С этого варианта запуска макрос работает не корректно...
(зачем я его запихивал уже и не помню)
Код - Auto/Visual Lisp [Выбрать]
  1. (defun c:dtest2 ()
  2.   (vl-load-com)
  3.   (vla-runmacro (vlax-get-acad-object) "C:/DVB/test.dvb!XplodeDims")
  4.   (while (/= (logand (getvar "cmdactive") 31) 0)
  5.   (command pause))
  6.   (princ)
  7. )

А если через: "^C^C-vbarun C:/DVB/test.dvb!XplodeDims" то все работает корректно...

Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 12-02-2019, 22:32:41
DMA,
Вызов из lisp'а кода на VBA иногда приводит к таким проблемам.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 12-02-2019, 23:36:23
Цитата: Александр Ривилис от 12-02-2019, 22:32:41
Вызов из lisp'а кода на VBA иногда приводит к таким проблемам.
А есть альтернативный код запускающий через Lisp макрос VBA работающий с выбором пользователя. Напрямую как я выше написал работает Ваш код. В моем макросе выбор набором примитивов работать не хочет.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 12-02-2019, 23:41:25
Цитата: DMA от 12-02-2019, 23:36:23
А есть альтернативный код запускающий через Lisp макрос VBA работающий с выбором пользователя.
Код - Auto/Visual Lisp [Выбрать]
  1. (command "-VBARUN" "C:/DVB/test.dvb!XplodeDims")
В последних версиях AutoCAD наверное:
Код - Auto/Visual Lisp [Выбрать]
  1. (command-s "-VBARUN" "C:/DVB/test.dvb!XplodeDims")
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 12-02-2019, 23:45:30
Спасибо! Первый вариант корректно сработал. :)
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 13-02-2019, 00:05:30
DMA,
Отлично! В дальнейшем пожалуйста каждый вопрос оформляй отдельной темой.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 19-02-2019, 13:32:06
Цитата: Александр Ривилис от 13-02-2019, 00:05:30
В дальнейшем пожалуйста каждый вопрос оформляй отдельной темой.
У меня вопрос в контексте данного обсуждения.
Вернулся к своему макросу и подвис на следующем же шаге. Не могу получить координаты отрезка.
Как только к нему не пытался достучаться. H1-корректный, aa1- всегда пустое значение
Доступ к координатам отрезка же через Startpoint/Endpoint? Или я ошибаюсь?

Код - Visual Basic [Выбрать]
  1. If ThisDrawing.ModelSpace.Item(i).ObjectName = "AcDbLine" Then
  2.         Set Ln = ThisDrawing.ModelSpace.Item(i)
  3.         H1 = Ln.Handle
  4.         Set aa1 = ThisDrawing.HandleToObject(H1)
  5.         MsgBox aa1.startPoint
  6.          End If

Я уже начал думать что, возможно, запуск макроса через Lisp и здесь сыграл определенную роль :))
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 19-02-2019, 14:26:47
DMA,
Как определен Ln? Ln.StartPoint и Ln.EndPoint должны возвращать то, что нужно.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 19-02-2019, 15:26:45
Цитата: Александр Ривилис от 19-02-2019, 14:26:47
Как определен Ln? Ln.StartPoint и Ln.EndPoint должны возвращать то, что нужно.

В настоящий момент как Dim Ln As AcadLine. Ноя уже перепробовал все что можно. Хотя может что и пропустил...
Название: Re: Прошу помощи с кодом. VBA
Отправлено: Александр Ривилис от 19-02-2019, 15:47:53
Код - Visual Basic [Выбрать]
  1. Sub GetLineStartEndPoints()
  2.     Dim nEnts As Integer
  3.     nEnts = ThisDrawing.ModelSpace.Count
  4.     For i = 0 To nEnts - 1
  5.     Dim ent As AcadEntity
  6.       Set ent = ThisDrawing.ModelSpace.Item(i)
  7.       If ent.ObjectName = "AcDbLine" Then
  8.         Dim line As AcadLine
  9.         Set line = ent
  10.         MsgBox "Start point: (" & line.StartPoint(0) & " " _
  11.            & line.StartPoint(1) & " " _
  12.            & line.StartPoint(2) & ")" & vbCrLf _
  13.            & "End point: (" & line.EndPoint(0) & " " _
  14.            & line.EndPoint(1) & " " _
  15.            & line.EndPoint(2) & ")"
  16.       End If
  17.     Next
  18. End Sub
Так должно работать.
Название: Re: Прошу помощи с кодом. VBA
Отправлено: DMA от 19-02-2019, 19:01:50
Цитата: Александр Ривилис от 19-02-2019, 15:47:53
Так должно работать.
Работает! Спасибо , большое. :)