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

ADN Club => VBA => Тема начата: Den_mi от 18-02-2020, 18:01:43

Название: Обновление атрибутов в блоке
Отправлено: Den_mi от 18-02-2020, 18:01:43
Доброго времени суток!
Есть динамические блоки "Рамка", с атрибутом "№" отвечающим за номер листа

следующий код меняет значение атрибута № второй рамки на формулу "№ первой рамки +1 "

Код - Visual Basic [Выбрать]
  1. Sub listplus()
  2. 'переменные
  3. Dim ss As AcadSelectionSet
  4. Dim idatt As String
  5. Dim str1 As String
  6. Dim str2 As String
  7. Dim selobj As AcadEntity
  8. Dim dynblock As AcadBlockReference
  9.  
  10. str1 = "%<\AcExpr (%<\AcObjProp Object(%<\_ObjId "
  11. str2 = ">%).TextString>%+1)>%"
  12.  
  13. 'выбор первого блока с которого считывается id атрибута номера
  14. On Error Resume Next
  15. ThisDrawing.SelectionSets("SS").Delete
  16. Set ss = ThisDrawing.SelectionSets.Add("SS")
  17. ss.SelectOnScreen
  18. For Each selobj In ss
  19.     If selobj.ObjectName = "AcDbBlockReference" Then
  20.         Set dynblock = selobj
  21.         If dynblock.EffectiveName = "Рамка" Then
  22.             atr = dynblock.GetAttributes
  23.             For i = LBound(atr) To UBound(atr)
  24.                 If atr(i).TagString = "№" Then
  25.                     idatt = atr(i).ObjectID
  26.                 End If
  27.             Next
  28.         End If
  29.     End If
  30. Next
  31.  
  32. 'выбор 2 блока куда записывается формула
  33. ThisDrawing.SelectionSets("SS").Delete
  34. Set ss = ThisDrawing.SelectionSets.Add("SS")
  35. ss.SelectOnScreen
  36. For Each selobj In ss
  37.     If selobj.ObjectName = "AcDbBlockReference" Then
  38.         Set dynblock = selobj
  39.         If dynblock.EffectiveName = "Рамка" Then
  40.             atr = dynblock.GetAttributes
  41.             For i = LBound(atr) To UBound(atr)
  42.                 If atr(i).TagString = "№" Then
  43.                     atr(i).TextString = str1 & idatt & str2
  44.                 End If
  45.             Next
  46.         End If
  47.     End If
  48. Next
  49.  
  50. ThisDrawing.Regen acActiveViewport
  51. End Sub

В принципе все работает но

последняя команда регенерации обновляет весь чертеж, что занимает время да и зачем его обновлять если поменялся всего один атрибут в конкретном блоке?
есть же замечательная команда _updatefield, так вот как можно прикрутить эту команду к коду? попробовал просто запуск команды через командную строку, но тогда как указать команде что обновлять надо именно 2 блок? то есть SelectionSets есть а как его прикрутить в команду не пойму

и еще вопрос, можно ли как то вставить в командную строку комментарий-запрос о том что именно надо выбрать при выборе 1 и 2 блоков, как например это происходит при запросе точки ThisDrawing.Utility.GetPoint(, "Выберите точку")?
Название: Re: Обновление атрибутов в блоке
Отправлено: Александр Ривилис от 18-02-2020, 18:05:01
Цитата: Den_mi от 18-02-2020, 18:01:43
попробовал просто запуск команды через командную строку, но тогда как указать команде что обновлять надо именно 2 блок? то есть SelectionSets есть а как его прикрутить в команду не пойму
Только через lisp-функцию (handent), которой передавать Handle второго блока. SelectionSet(s) прикрутить не получится.
Название: Re: Обновление атрибутов в блоке
Отправлено: Александр Ривилис от 18-02-2020, 18:10:12
Цитата: Den_mi от 18-02-2020, 18:01:43
и еще вопрос, можно ли как то вставить в командную строку комментарий-запрос о том что именно надо выбрать при выборе 1 и 2 блоков, как например это происходит при запросе точки ThisDrawing.Utility.GetPoint(, "Выберите точку")?
Тут два варианта:
1. Комментарий без запроса:
Код - Visual Basic [Выбрать]
  1. ThisDrawing.Utility.Prompt("Выберите блок")
2. Запрос по одному примитиву:
Код - Visual Basic [Выбрать]
  1. ThisDrawing.Utility.GetEntity returnObj, basePnt, "Выберите блок"
Название: Re: Обновление атрибутов в блоке
Отправлено: Алексей Кулик от 18-02-2020, 20:02:42
Просто в качестве идеи, без проверок:
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub ListPlus()
  4. Dim sPrefix As String
  5. Dim sSuffix As String
  6. Dim selRes As AcadEntity
  7. Dim selPoint As Variant
  8. Dim dynBlockRef As AcadBlockReference
  9. Dim atrCol As Object
  10. Dim numAtrId As String
  11. Dim i As Integer
  12.  
  13. sPrefix = "%<\AcExpr (%<\AcObjProp Object(%<\_ObjId "
  14. sSuffix = ">%).TextString>%+1)>%"
  15.  
  16.     On Error GoTo lErrorSelect
  17.     ThisDrawing.Utility.GetEntity selRes, selPoint, "\nSelect source block reference <Cancel> : "
  18.     On Error GoTo lErrorNoBlock
  19.     Set dynBlockRef = selRes
  20.     If dynBlockRef.EffectiveName.UCase = "РАМКА" Then
  21.         atrCol = dynBlockRef.GetAttributes
  22.         For i = LBound(atrCol) To UBound(atrCol)
  23.             If atrCol(i).TagString = "№" Then
  24.                 numAtrId = CStr(atrCol(i).ObjectID)
  25.                 GoTo lExitFor
  26.             End If
  27.         Next i
  28. lExitFor:
  29.         On Error GoTo lErrorSelect
  30.         ThisDrawing.Utility.GetEntity selRes, selPoint, "\nSelect destination block reference <Cancel> : "
  31.         On Error GoTo lErrorNoBlock
  32.         Set dynBlockRef = selRes
  33.         If dynBlockRef.EffectiveName.UCase = "РАМКА" Then
  34.             atrCol = dynBlockRef.GetAttributes
  35.             For i = LBound(atrCol) To UBound(atrCol)
  36.                 If atrCol(i).TagString = "№" Then
  37.                     atrCol(i).TextString = sPrefix & numAtrId & sSuffix
  38.                     atrCol(i).Update ' Вариант 1
  39.                    GoTo lExitFor2
  40.                 End If
  41.             Next i
  42. lExitFor2:
  43.             dynBlockRef.Update  ' Вариант 2
  44.            ThisDrawing.SendCommand "_.updatefield (handent " & Chr(34) & dynBlockRef.Handle & Chr(34) & ") " ' Вариант 3
  45.        End If
  46.     End If
  47.     Exit Sub
  48. lErrorSelect:
  49.     ThisDrawing.Utility.Prompt "\nError selection"
  50.     On Error GoTo 0
  51.     Exit Sub
  52. lErroBlock:
  53.     ThisDrawing.Utility.Prompt "\nThat's not block reference"
  54.     On Error GoTo 0
  55.     Exit Sub
  56. End Sub
Название: Re: Обновление атрибутов в блоке
Отправлено: Den_mi от 19-02-2020, 10:40:10
Александр Ривилис
Да это то что нужно!
а использование запроса по одному объекту даже удобнее!


Алексей Кулик

Метод Update для обновления атрибута (1 вариант) и всего блока (2 вариант) не сработали, зато сработал 3 вариант
Только там после скобки еще одного пробела не хватало. И спасибо за пример кода с отловом ошибок  ;)

Код - Visual Basic [Выбрать]
  1. ThisDrawing.SendCommand "_.updatefield (handent " & Chr(34) & dynBlockRef.Handle & Chr(34) & ")  " ' Вариант 3

Всем спасибо, вопрос закрыт