Dim acadapp As AcadApplication '在屏幕上取块
Set acadapp = GetObject(, "autocad.application")
Dim acaddoc As AcadDocument
Set acaddoc = acadapp.ActiveDocument
Dim entityset As AcadSelectionSet
'frm.hide
100 Set entityset = acaddoc.ActiveSelectionSet
entityset.Clear
entityset.SelectOnScreen
If entityset.Count = 0 Or entityset.Count > 1 Then
MsgBox "没有选择一个块或选择过多"
GoTo 100
End If '下面是取所选择的块
Dim obj As AcadEntity
Dim varattributes As Variant
Set obj = entityset.SelectOnScreen
If obj.ObjectName = "VM" Then 'VM是块的名称
If .HasAttributes Then
vaattributes = .GetAttributes
End If
End If
必须先定义一个二维数组
如：
Dim AttArray(1, UBound(vaattributes)) As Variant
然后在下面的循环中把属性填充到数组中：
For J = 0 To UBound(vaattributes)
AttArray(0,J)=vaattributes(J).TagString
AttArray(1,J) = attvars(J).TextString
Next
置顶卡
