GetAttributes Пример

Sub Example_GetAttributes()
    ' Этот пример создает блок. Затем добавляет атрибуты к этому блоку. Блок
    ' вставляется в рисунок, чтобы создать вхождение блока.
    
    ' Создайте блок
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "TESTBLOCK")
    
    ' Определите определение атрибута
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeVerify
    prompt = "Attribute Prompt"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
    tag = "Attribute Tag"
    value = "Attribute Value"
    
    ' Создайте объект определения атрибута в пространстве модели
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
    
   
    ' Вставьте блок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "TESTBLOCK", 1#, 1#, 1#, 0)
    ZoomAll
    
    ' Получите атрибуты для вхождения блока
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
    
    ' Переместите тэгы атрибута и значения в строку, которая будет показана в Msgbox
    Dim strAttributes As String
    Dim I As Integer
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & "  Tag: " & varAttributes(I).TagString & _
                        "   Value: " & varAttributes(I).textString & "    "
    Next
    MsgBox "Атрибуты для blockReference " & blockRefObj.name & "  : " & strAttributes, , "GetAttributes Пример"
    
    ' Измените значение атрибута
    ' Обратите внимание: нет никакого SetAttributes. Как только Вы сделали массив variant, Вы имеете объекты.
    ' Изменение их изменяет объекты в рисунке.
    varAttributes(0).textString = "NEW VALUE!"
    
    ' Получите атрибуты
    Dim newvarAttributes As Variant
    newvarAttributes = blockRefObj.GetAttributes
    
    ' Снова, покажите тэгы и значения
    strAttributes = ""
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & "  Tag: " & varAttributes(I).TagString & _
                        "   Value: " & varAttributes(I).textString & "    "
    Next
    MsgBox "Атрибуты для blockReference " & blockRefObj.name & "  : " & strAttributes, , "GetAttributes Пример"
    
End Sub
Сайт управляется системой uCoz