|
|
发表于 2009-5-31 20:07:00
|
显示全部楼层
On Error Resume Next
Set AcadApp = GetObject(, "Autocad.application") '启动Autocad2000
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
AcadApp.Visible = True
AppActivate AcadApp.Caption 'Cad得到焦点
Dim acadobj As AcadObject
AcadApp.ActiveDocument.Utility.GetEntity acadobj, pnt, "提示" '单选
Dim xType As Variant
Dim xData As Variant
acadobj.GetXData "", xType, xData
b = UBound(xType)
AcadApp.ActiveDocument.Utility.Prompt vbCrLf
'MsgBox B
If IsEmpty(xType) Then
AcadApp.ActiveDocument.Utility.Prompt "无扩展数据!"
Exit Sub
End If
For CC = 0 To b
ac = xType(CC) & "->"
AB = xData(CC)
AcadApp.ActiveDocument.Utility.Prompt Str(CC) & " " & ac & AB
AcadApp.ActiveDocument.Utility.Prompt vbCrLf |
|
置顶卡
