属性块的使用-CAD-VBA源码

Option Explicit

' 创建一个带有属性的块
Public Sub CreateAttBlk()
Dim ptBase(0 To 2) As Double
ptBase(0) = 0: ptBase(1) = 0: ptBase(2) = 0

' 添加块定义
Dim objBlkDef As AcadBlock
Set objBlkDef = ThisDrawing.Blocks.Add(ptBase, "属性块")

' 向块定义中添加图形对象
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
pt1(0) = -10: pt1(1) = 0: pt1(2) = 0
pt2(0) = 10: pt2(1) = 0: pt2(2) = 0
objBlkDef.AddLine pt1, pt2

pt1(0) = 0: pt1(1) = -10: pt1(2) = 0
pt2(0) = 0: pt2(1) = 10: pt2(2) = 0
objBlkDef.AddLine pt1, pt2

objBlkDef.AddCircle ptBase, 6

objBlkDef.AddAttribute 5, 0, "输入插入点坐标:", ptBase, "插入点坐标", CStr("(100, 100)")
End Sub

' 插入带属性的块
Public Sub InsertAttBlk()
' 插入块
Dim objBlkRef As AcadBlockReference
Dim ptInsert(0 To 2) As Double
ptInsert(0) = 100: ptInsert(1) = 100: ptInsert(2) = 0
Set objBlkRef = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "属性块", 1, 1, 1, 0)
ZoomAll

' 获得块参照的属性
Dim varAttributes As Variant
varAttributes = objBlkRef.GetAttributes
varAttributes(0).TextString = "(200, 200)"
End Sub