Attribute properties example
Sub AttributeProps_Example()
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)
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)
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"
Set attributeObj = blockObj.AddAttribute(dHeight, acAttributeModeVerify, sPrompt, insPt, sTag, sValue)
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. |