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

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

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

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

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

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

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

  • Administrator
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь 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
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь 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
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь 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
  • *****
  • Сообщений: 13886
  • Карма: 1788
  • Рыцарь 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 видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение