Attribute properties example

Sub AttributeProps_Example()
' This example creates a block containing a line and an arc.
' It then inserts the block, adds attributes and
' returns various properties of the attributes.
    ' Define the block
    Dim blockObj As AcadBlock
    Dim sBlockName As String
    sBlockName = InputBox("Enter a block name")
    Dim insPt(0 To 2) As Double: insPt(0) = 4: insPt(1) = 3: insPt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insPt, sBlockName)
    ' Add a a line and an arc to the block
    Dim lineObj As AcadLine
    Dim startPt(0 To 2) As Double: startPt(0) = 0: startPt(1) = 0: startPt(2) = 0
    Dim endPt(0 To 2) As Double: endPt(0) = 4: endPt(1) = 4: endPt(2) = 0
    Set lineObj = blockObj.AddLine(startPt, endPt)
    Dim arcObj As AcadArc
    Dim cenPt(0 To 2) As Double: cenPt(0) = 3: cenPt(1) = 4: cenPt(2) = 0
    Dim dRadius As Double: dRadius = 1
    Set arcObj = blockObj.AddArc(cenPt, dRadius, 1, 2)
    ' Define the attribute definition
    Dim attributeObj As AcadAttribute
    Dim dHeight As Double: dHeight = 1
    Dim sPrompt As String: sPrompt = "This the attribute's prompt"
    Dim sTag As String: sTag = "This the attribute's tag"
    Dim sValue As String: sValue = "This the attribute's value"
    ' Create the attribute definition object in model space
    Set attributeObj = blockObj.AddAttribute(dHeight, acAttributeModeVerify, sPrompt, insPt, sTag, sValue)
    ' Insert the block
    Dim blockRefObj As AcadBlockReference
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insPt, sBlockName, 1, 1, 1, 0)
    MsgBox "The block " & sBlockName & " has been inserted."
    If blockRefObj.HasAttributes Then
        Dim vAtt As Variant: vAtt = blockRefObj.GetAttributes
        Dim i As Integer
        For i = LBound(vAtt) To UBound(vAtt)
            MsgBox "Tag String: " & vAtt(i).TagString & _
                Chr(13) & "Field length: " & vAtt(i).FieldLength & _
                Chr(13) & "Constant property: " & vAtt(i).Constant & _
                Chr(13) & "Height property: " & vAtt(i).Height & _
                Chr(13) & "Visible property: " & vAtt(i).Visible
        Next
    End If
End Sub

© Bricsys NV. All rights reserved.