Sub ShowBlockAttrib()
Dim N, M, b As Integer
Dim AttStr As String
Dim Attrefs As Variant
AttStr = ""
'定义选择集
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("SS3")
sset.SelectOnScreen
'在选择集中找属性
Dim Entry As AcadEntity
For Each Entry In sset
If Entry.ObjectName = "AcDbBlockReference" and Entry.HasAttributes Then
AttStr = AttStr + Entry.Name + "图块中的属性有:" + Chr(13)
Attrefs = Entry.GetAttributes
For M = LBound(Attrefs) To UBound(Attrefs)
AttStr = AttStr + Attrefs(M).TagString + " = " + Attrefs(M).TextString + Chr(13)
Next M
AttStr = AttStr + Chr(13)
End If
Next Entry