[例程]块属性值编辑
Public Sub GetAttribute()'本段代码从选中的图块中获取属性值，并对其修改
Dim entObj As AcadEntity
Dim pickPnt As Variant
Dim blkRefObj As AcadBlockReference
'选择图元
ThisDrawing.Utility.GetEntity entObj, pickPnt
'判断是否为块引用
If StrComp(entObj.ObjectName, "AcDbBlockReference", 1) <> 0 Then
MsgBox "你选择的不是一个图块，程序将退出！"
'如果选择的不是一个块引用则程序退出运行
Exit Sub
End If
'如果选择的是块引用，将其赋给块引用对象
Set blkRefObj = entObj
'判断该块引用是否含有属性值
If Not blkRefObj.HasAttributes Then
MsgBox "你选择的图块没有块属性，程序将退出！"
'如果不含由属性值退出
Exit Sub
End If
Dim attVars As Variant
Dim I As Integer
'获取块引用中的块属性对象
attVars = blkRefObj.GetAttributes
'对块属性对象进行遍历
For I = 0 To UBound(attVars)
MsgBox "第" & I + 1 & "属性对象的属性值分别如下：" & Chr(13) & Chr(13) & _
"属性标签为：" & attVars(I).TagString & Chr(13) & _
"属性值为：" & attVars(I).TextString
Next
'将块属性的标签和值进行修改
attVars(0).TagString = "New Tag"
attVars(0).TextString = "New Value"
ThisDrawing.Regen True
End Sub
页:
[1]