Sub Example_GetConstantAttributes()
    ' Этот пример создает постоянное определение атрибута на блоке.
    ' Затем делает запрос блока, чтобы возвратить атрибут.
    
    ' Создайте блок, чтобы держать атрибут
    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, "New_Block")
    
    ' Определите определение атрибута
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeConstant
    prompt = "Constant Prompt"
    insertionPnt(0) = 5#: insertionPnt(1) = 5#: insertionPnt(2) = 0#
    tag = "Constant Tag"
    value = "Constant Value"
    
    ' Создайте объект определения атрибута на блоке
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPnt, tag, value)
    ZoomAll
    
    ' Вставьте блок в рисунок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "New_Block", 1#, 1#, 1#, 0)
    
    ' Получите постоянное определение атрибута от блока
    Dim queryAttribute As Variant
    queryAttribute = blockRefObj.GetConstantAttributes
    
    Dim count As Integer
    count = UBound(queryAttribute) - LBound(queryAttribute)
    MsgBox "Вхождение блока имеет " & count & " постоянных атрибута. "
End Sub