[例程]块属性值编辑

mccad

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