VB提取CAD块属性

Dim myAcadApp As AutoCAD.AcadApplication, activeDoc As AutoCAD.AcadDocument, acMS As AutoCAD.AcadModelSpace
Set myAcadApp = CreateObject("Autocad.Application")
Set activeDoc = myAcadApp.ActiveDocument

Dim I%
Dim entry As AcadEntity, blk1 As AcadBlockReference, att1 As AcadAttributeReference
Dim varAttributes As Variant
Dim strAttributes As String
For Each entry In activeDoc.ModelSpace
If entry.ObjectName = "AcDbBlockReference" Then
Set blk1 = entry
if blk1.name="?????" then'你的块名
varAttributes = entry.GetAttributes
strAttributes = ""
For I = LBound(varAttributes) To UBound(varAttributes)
Set att1 = varAttributes(I)
strAttributes = strAttributes & "标记：" & att1.TagString & "，值：" & att1.TextString & "。"
'自己想怎么用就怎么用^_^
Next
end if
End If

Next