• DLL
  • Восстановленный участник
  • На форуме с 18 апреля 2006г.
  • Сообщений: 6
  • Спасибо: 0

Тема: Как одновременно изменить атрибуты в нескольких одинаковых блоках ?

Есть несколько блоков. В каждом есть Enhanced attribute с Value = 1. Эти блоки копирую 5 раз. Получается 5 одинаковых блоков.
Как реализовать?
Нужно последовательно выделить блоки (допустим 5 штук) и в порядке их выделения поменять Value у атрибутов в блоке с допустим 1 до 5

  • На форуме с 21 июня 2005г.
  • Сообщений: 21
  • Спасибо: 0

Re: Как одновременно изменить атрибуты в нескольких одинаковых блоках ?

> DLL
ну например (кусок из рабочего фрагмента):

Sub Main()
Dim StOld As String
Dim StNew As String
Dim Object As AcadObject
Const OutletName As String = "Outlet"
Dim basePnt As Variant
Dim st As String
Dim varAttributes As Variant
Dim OAttr As AcadAttributeReference
Dim II As Integer
On Error GoTo Error_Control
 ThisDrawing.Utility.Prompt vbLf
OCtrlForm1.Show
uv_ExitOCtrlFlag = False
StOld = GetSocNumber
While Not uv_ExitOCtrlFlag
 ThisDrawing.Utility.GetEntity Object, basePnt, "Select a socket ( " & StOld & " ):"
  If TypeName(Object) = "IAcadBlockReference" Then
   st = Mid(Object.Name, 1, 6)
   If st = OutletName Then
    varAttributes = Object.GetAttributes
    For II = LBound(varAttributes) To UBound(varAttributes)
     st = varAttributes(II).TagString
     If st = "OUTLETNUMBER" Then
      StOld = GetSocNumber
      varAttributes(II).TextString = StOld
      StOld = IncSocNumber
      Set OAttr = varAttributes(II)
     End If
    Next
   End If
  End If
 Wend
Exit Sub
Error_Control:
 If Not uvkernel.errorhandlerA Then
  Resume
 Else
  uv_ExitOCtrlFlag = True
  Unload OCtrlForm1
  Exit Sub
 End If
End Sub