|
|
源代码如下：
'VBA代码创建带属性的块
Public Sub createATTBlockTX()
Dim objBlock As AcadBlock
Dim ptBase(2) As Double '插入块时的基点
Dim pt1(2) As Double, pt2(2) As Double, pt3(2) As Double, pt4(2) As Double
pt1(0) = 2: pt1(1) = 0: pt1(2) = 0
pt2(0) = -2: pt2(1) = 0: pt2(2) = 0
pt3(0) = 0: pt3(1) = 2: pt3(2) = 0
pt4(0) = 0: pt4(1) = -2: pt4(2) = 0
Dim ptArr(3) As Double
ptArr(0) = 2: ptArr(1) = 0: ptArr(2) = -2: ptArr(3) = 0
ptBase(0) = 0: ptBase(1) = 0: ptBase(2) = 0
Set objBlock = ThisDrawing.Blocks.Add(ptBase, "天线")
objBlock.AddLine pt1, pt2
objBlock.AddLine pt3, pt4
objBlock.AddCircle ptBase, 2
objBlock.AddLightWeightPolyline ptArr
'更改块中多段线的属性
Dim objLWP As AcadLWPolyline
Set objLWP = objBlock.Item(3)
objLWP.SetBulge 0, 1
objLWP.SetBulge 1, 1
objLWP.Closed = True
objLWP.ConstantWidth = 0.5
'设置块的属性
ptBase(0) = 3: ptBase(1) = 0: ptBase(2) = 0
objBlock.AddAttribute 2, acAttributeModeLockPosition, "FF", ptBase
ptBase(0) = 3: ptBase(1) = -2: ptBase(2) = 0
objBlock.AddAttribute 2, acAttributeModeLockPosition, "DD", ptBase
End Sub
如果不设置块的属性可以创建块，设置之后AddAttribute 提示参数不可选
|
|
置顶卡
