Прошу помощи с кодом. VBA

Автор Тема: Прошу помощи с кодом. VBA  (Прочитано 15516 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Прошу помощи с кодом. VBA
« : 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.  

« Последнее редактирование: 05-02-2019, 20:38:23 от Александр Ривилис »

Отмечено как Решение Александр Ривилис 05-02-2019, 20:45:03

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #1 : 05-02-2019, 20:39:38 »
Фильтруй по "DIMENSION"
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #2 : 05-02-2019, 20:43:47 »
Ура!!!
Спасибо большое. Я уже был близок к верному решению путем перебора вариантов :)))

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #3 : 05-02-2019, 20:45:56 »
DMA,
Прочитай у меня в подписи о форматировании кода на форуме.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 611
  • Карма: 155
    • ПГСу Бложик
Re: Прошу помощи с кодом. VBA
« Ответ #4 : 05-02-2019, 22:18:14 »
DMA, добавлю только: чтобы в публикуемом коде кириллица нормально вставлялась, копировать код в буфер обмена нужно при включенной русской раскладке клавиатуры.

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #5 : 05-02-2019, 22:19:34 »
спасибо за полезное замечание. В будущем учту.

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #6 : 08-02-2019, 15:47:34 »
Не найдя для себя приемлемого способа получения из размеров точек привязки размерных линий (из пары решений найденных одно не подошло, с другим не смог разобраться), решил действовать так:
1. Скопировать размер.
2. Изменить стиль размера убрав стрелки.
3. взорвать его
4. проанализировать останки и найти точки привязки (они на свободных концах отрезков)
5. удалить оставшееся.

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

И еще как можно более тонко отфильтровать размер? DIMENSIONS же сгребает все размеры в кучу?

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 611
  • Карма: 155
    • ПГСу Бложик
Re: Прошу помощи с кодом. VBA
« Ответ #7 : 08-02-2019, 16:08:00 »
на dwg не так давно была похожая тема, посмотрите, может поможет: ссылка

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #8 : 08-02-2019, 17:42:59 »
Кода с собой нет, показать не могу, но возможно и так будет понятно...
Нет. Без кода - гадание на кофейной гуще.
И еще как можно более тонко отфильтровать размер? 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
Цитировать
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
« Последнее редактирование: 09-02-2019, 00:21:07 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #9 : 08-02-2019, 22:17:11 »
Нет. Без кода - гадание на кофейной гуще.

Код - 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. А как правильно задать не понимаю. :(

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #10 : 08-02-2019, 23:11:42 »
на dwg не так давно была похожая тема, посмотрите, может поможет: ссылка

Спасибо большое, посмотрю.
Единственно мне интересно уже свой способ добить тоже.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #11 : 09-02-2019, 00:07:00 »
Dim dim1Obj As Variant
Почему?
Скорее уж AcadObject, или один из классов размеров: Dim3PointAngular, DimAligned, DimAngular, DimArcLength, DimDiametric, DimRotated
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #12 : 09-02-2019, 01:05:26 »
Почему?
Скорее уж AcadObject, или один из классов размеров: Dim3PointAngular, DimAligned, DimAngular, DimArcLength, DimDiametric, DimRotated

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

-- заметил еще что если dim1Obj определе НЕ как AcadObject, то сыпется все чуть раньше,- на входе.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #13 : 09-02-2019, 01:23:06 »
Тем не менее такая конструкция должна работать при корректном handle:
Код - Visual Basic [Выбрать]
  1.     Dim tempObj As AcadObject
  2.     Set tempObj = ThisDrawing.HandleToObject(handle)
В противном случае это или баг в конкретной версии или проблема с твоим AutoCAD / Windows
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #14 : 09-02-2019, 01:52:41 »
DMA,
А тут я вообще не понял:
Код - Visual Basic [Выбрать]
  1. Set dim1Obj = ThisDrawing.HandleToObject(mass)
  2. dimObj.Arrowhead1Type = acArrowBoxBlank
В одном месте dim1Obj, а в другом dimObj
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #15 : 09-02-2019, 02:06:51 »
В одном месте dim1Obj, а в другом dimObj
да Ё-моё... исправил все. работает.
Спасибо Александр большое.
Сажусь после работы за комп, концентрация совсем никуда...

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #16 : 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?

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #17 : 10-02-2019, 14:49:41 »
1. Александр, не подскажете почему не работает explode применительно к размерам?
Увы, но в очередной раз мы попадаем на ограничение VBA в AutoCAD. Только для этих типов объектов есть метод Explode:

P.S.: Рекомендую побыстрее забыть про VBA и перейти на .NET (лучше C#) для AutoCAD

Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #18 : 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
« Последнее редактирование: 10-02-2019, 16:44:40 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 611
  • Карма: 155
    • ПГСу Бложик
Re: Прошу помощи с кодом. VBA
« Ответ #19 : 10-02-2019, 17:55:07 »
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #20 : 10-02-2019, 17:57:49 »
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.
Лучше всего вообще не пользоваться VBA. Смещение хендла в разных версиях AutoCAD (а возможно и внутри) одной может быть разным. А если чертеж пришел (не дай Бог) из какого-то клона AutoCAD, то может быть совсем печально...
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #21 : 10-02-2019, 18:42:58 »
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Кстати, блок взрывать не нужно (и невозможно) - это же не INSERT, а BLOCK. По нему можно просто пройтись итератором.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 611
  • Карма: 155
    • ПГСу Бложик
Re: Прошу помощи с кодом. VBA
« Ответ #22 : 10-02-2019, 19:29:23 »
Кстати, блок взрывать не нужно (и невозможно) - это же не INSERT, а BLOCK. По нему можно просто пройтись итератором.
ну я примерно на это и намекал в 7 сообщении...

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #23 : 10-02-2019, 22:25:55 »
P.S.: Рекомендую побыстрее забыть про VBA и перейти на .NET (лучше C#) для AutoCAD

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

Вот в сети нарыл системную переменную DIMASSOC=0 (при 0 вставляет размер взорванным) , но как ее прикрутить к программе и возможно ли это вообще не понял пока.
Но в целом я так примерно и думал в направлении запуска внешней команды, единственно долго бы тупил, без подсказки, как это правильно оформить :)

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #24 : 10-02-2019, 22:28:46 »
А если попробовать найти блок отвечающий за размер и взрывать уже его, для блока метод explode вроде работает...
Да, придется проверить смещения хендла для различных типов размеров, но это всяко лучше командного метода.
для меня это наверное пока рановато. Идея в принципе понятна, но я вязну на раз два в особенностях автокада (+ совсем начальные знания по vba)...

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #25 : 11-02-2019, 00:12:20 »
Вот в сети нарыл системную переменную DIMASSOC=0 (при 0 вставляет размер взорванным) , но как ее прикрутить к программе и возможно ли это вообще не понял пока.
Размеры у тебя уже вставлены, так что никакая системная переменная на них не повлияет.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #26 : 11-02-2019, 01:14:30 »
Вот так можно расчленить размер:
Спасибо, размеры взрываются, единственно автокад считает что после взрыва добавлен только один элемент (в моем случае это AcDbAlignedDimension) хотя все в модели взорвано на кусочки...

Размеры у тебя уже вставлены, так что никакая системная переменная на них не повлияет.
а если скопировать размер с этой системной переменной=0 , так не получится (это уже чисто ради интереса)?

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #27 : 11-02-2019, 01:19:15 »
Спасибо, размеры взрываются, единственно автокад считает что после взрыва добавлен только один элемент (в моем случае это AcDbAlignedDimension) хотя все в модели взорвано на кусочки...
Ты проверял с моим кодом? Размеры у тебя в модели или в листе? Если в листе, то вместо modelspace должно быть paperspace.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #28 : 11-02-2019, 01:20:57 »
а если скопировать размер с этой системной переменной=0 , так не получится (это уже чисто ради интереса)?
Нет конечно. Эта системная переменная влияет только на создание размеров командой AutoCAD.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #29 : 11-02-2019, 01:35:44 »
Ты проверял с моим кодом? Размеры у тебя в модели или в листе? Если в листе, то вместо modelspace должно быть paperspace.
да, проверял с Вашим кодом. Размеры в модели.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #30 : 11-02-2019, 01:47:43 »
DMA,
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #31 : 11-02-2019, 01:51:37 »
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
F.205.0.0 Autocad 2012 russian sp2
чертеж абсолютно пустой, проставляю размер в пустоту и запускаю макрос.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #32 : 11-02-2019, 10:15:46 »
Мне нужен чертеж, с которым ты проверял и номер версии AutoCAD
F.205.0.0 Autocad 2012 russian sp2
чертеж абсолютно пустой, проставляю размер в пустоту и запускаю макрос.
Специально проверил в AutoCAD 2012 SP2 (у меня английский, но это не должно влиять). Всё работает как надо:


Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #33 : 11-02-2019, 10:32:21 »
Еще раз перепроверил на рабочем компьютере, здесь тоже 2012. Не работает.
В чем Вы , кстати, видео записываете?
Есть ли сервайс пак 3 на 2012 интересно?

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #34 : 11-02-2019, 10:33:58 »
В чем Вы , кстати, видео записываете?
Прочитай у меня в подписи.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #35 : 11-02-2019, 10:38:29 »
Проверил в 2015, тоже не работает.
Вряд ли это некорректная работа обеих версий. Тут видимо что-то еще...

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #36 : 11-02-2019, 10:46:29 »
Прочитай у меня в подписи.
если нужно, вечером запишу и отправлю.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #37 : 11-02-2019, 12:49:08 »
Прочитай у меня в подписи.
если нужно, вечером запишу и отправлю.
Не помешает понять что у тебя происходит. Возможно взаимодействие с какими-то другими программами. Я проверил даже в древнем 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
« Последнее редактирование: 11-02-2019, 14:33:14 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #38 : 11-02-2019, 14:14:04 »
нет, тоже самое. + в конце выбор еще одного размера для разбивки без вывода информации...

Оффлайн Дмитрий Загорулькин

  • ADN
  • *
  • Сообщений: 2531
  • Карма: 735
Re: Прошу помощи с кодом. VBA
« Ответ #39 : 11-02-2019, 14:43:33 »
Я проверил даже в древнем AutoCAD 2008 - всё работает.
Проверил в AutoCAD as Civil 3D 2014 - работает. Видео:

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #40 : 11-02-2019, 14:49:15 »
Проверил в AutoCAD as Civil 3D 2014 - работает.
ё-моё, почему интересно у меня-то не хочет. Вечером еще до 2-х компов с Автокадом дойду, попробую.

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #41 : 11-02-2019, 17:21:19 »
в 2018-ом работает правильно...
на той же машине где 2012,2015

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #42 : 11-02-2019, 17:26:28 »
в 2018-ом работает правильно...
на той же машине где 2012,2015
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся. Например, какие-то установленные приложения к AutoCAD.
Или нестандартное состояние системных переменных.
Можно попробовать создать новый профиль AutoCAD, переключится на него, выполнить его сброс и проверить код.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #43 : 11-02-2019, 20:13:40 »
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся.
при экспортировании в Автокад 2018 панелек с кнопками макросов, через какое-то время (или сразу) , перестал работать данный код :)))
сброс настроек профиля ни к чему не привел  (хотя я возможно сделал не то что нужно).

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #44 : 11-02-2019, 20:47:14 »
Значит, как я и предположил, что-то мешает этому коду правильно выполнятся.
при экспортировании в Автокад 2018 панелек с кнопками макросов, через какое-то время (или сразу) , перестал работать данный код :)))
сброс настроек профиля ни к чему не привел  (хотя я возможно сделал не то что нужно).

Ну теперь становится ясно, что проблема в этих панельках.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #45 : 11-02-2019, 22:18:28 »
Ну теперь становится ясно, что проблема в этих панельках.
как появится время попробую выяснить конкретнее, что является причиной такого поведения автокада...

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #46 : 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" то все работает корректно...


Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #47 : 12-02-2019, 22:32:41 »
DMA,
Вызов из lisp'а кода на VBA иногда приводит к таким проблемам.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #48 : 12-02-2019, 23:36:23 »
Вызов из lisp'а кода на VBA иногда приводит к таким проблемам.
А есть альтернативный код запускающий через Lisp макрос VBA работающий с выбором пользователя. Напрямую как я выше написал работает Ваш код. В моем макросе выбор набором примитивов работать не хочет.

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #49 : 12-02-2019, 23:41:25 »
А есть альтернативный код запускающий через 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")
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #50 : 12-02-2019, 23:45:30 »
Спасибо! Первый вариант корректно сработал. :)

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #51 : 13-02-2019, 00:05:30 »
DMA,
Отлично! В дальнейшем пожалуйста каждый вопрос оформляй отдельной темой.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #52 : 19-02-2019, 13:32:06 »
В дальнейшем пожалуйста каждый вопрос оформляй отдельной темой.
У меня вопрос в контексте данного обсуждения.
Вернулся к своему макросу и подвис на следующем же шаге. Не могу получить координаты отрезка.
Как только к нему не пытался достучаться. 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 и здесь сыграл определенную роль :))

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #53 : 19-02-2019, 14:26:47 »
DMA,
Как определен Ln? Ln.StartPoint и Ln.EndPoint должны возвращать то, что нужно.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #54 : 19-02-2019, 15:26:45 »
Как определен Ln? Ln.StartPoint и Ln.EndPoint должны возвращать то, что нужно.

В настоящий момент как Dim Ln As AcadLine. Ноя уже перепробовал все что можно. Хотя может что и пропустил...

Онлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Прошу помощи с кодом. VBA
« Ответ #55 : 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
Так должно работать.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн DMAАвтор темы

  • ADN OPEN
  • Сообщений: 35
  • Карма: 0
Re: Прошу помощи с кодом. VBA
« Ответ #56 : 19-02-2019, 19:01:50 »
Так должно работать.
Работает! Спасибо , большое. :)