HasAttributes Пример

Sub Example_HasAttributes()
    ' Этот пример сначала создает блок без атрибутов.
    ' Затем вставляет блок и проверяет, имеет ли он атрибуты.
    ' Затем добавляет атрибуты к блоку и вставляет его снова.
    ' Проверяет новое вхождение блока для атрибутов.
    
    ' Создайте блок
    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, "CircleBlock")
    
    ' Добавьте круг к блоку
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0
    radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
   
    ' Вставьте блок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    ThisDrawing.Application.ZoomAll
    MsgBox "Это вхождение блока " & IIf(blockRefObj.HasAttributes, "имеет атрибуты.", "не имеет атрибутов."), , "Has Attributes Пример"
    
    
    ' Добавьте атрибуты к выделению блока.
    ' Определите определение атрибута.
    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) = 1#: insertionPoint(1) = 1#: insertionPoint(2) = 0
    tag = "Attribute Tag"
    value = "Attribute Value"
    
    ' Создайте определение атрибута
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
       
    ' Вставьте блок снова
    Dim blockRefObj2 As AcadBlockReference
    insertionPnt(0) = 3#: insertionPnt(1) = 3#: insertionPnt(2) = 0
    Set blockRefObj2 = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    ZoomAll
    MsgBox "Первое вхождение блока " & IIf(blockRefObj.HasAttributes, "имеет атрибуты.", "не имеет атрибутов.") & vbCrLf & _
            "Второе вхождение блока " & IIf(blockRefObj2.HasAttributes, "имеет атрибуты.", "не имеет атрибутов."), , "Has Attributes Пример"

End Sub
Сайт управляется системой uCoz