分享一段VB获取CAD对象扩展数据的小代码

dong20030432

分享一段获取CAD对象扩展数据的小代码，请高手批评指正，谢谢！！！

1.    
   
2.     Dim xdataOut As Variant
   
3.     Dim xtypeOut As Variant
   
4.     Dim acadapp as object
   
5.     Dim entobj as object
   
6.     Dim BasePnt As Variant
   
7.     Dim tmp As String
   
8.     Dim i As Long
   
9.     On Error Resume Next
   
10.     AppActivate acadapp.Caption
    
11.     acadapp.ActiveDocument.Utility.GetEntity entobj, BasePnt, "请拾取参考实体"
    
12.     entobj.GETXDATA "", xtypeOut, xdataOut
    
13.     tmp=""
    
14.     If IsArray(xdataOut) = True Then
    
15.     For i = LBound(xdataOut) To UBound(xdataOut)
    
16.     If xtypeOut(i) = 1011 Then
    
17.     tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i)(0) & " " & xdataOut(i)(1) & " " & xdataOut(i)(2) & vbLf
    
18.     Else
    
19.     tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i) & vbLf
    
20.     End If
    
21.     Next
    
22.     acadapp.ActiveDocument.Utility.Prompt "扩展数据：" & vbLf & tmp & vbLf
    
23.     End If
    
24.     If Len(tmp) = 0 Then acadapp.ActiveDocument.Utility.Prompt "此对象无扩展数据！" & vbLf

    <br />     Dim xdataOut As Variant<br />     Dim xtypeOut As Variant<br />     Dim acadapp as object<br />     Dim entobj as object<br />     Dim BasePnt As Variant<br />     Dim tmp As String<br />     Dim i As Long<br />     On Error Resume Next<br />     AppActivate acadapp.Caption<br />     acadapp.ActiveDocument.Utility.GetEntity entobj, BasePnt, "请拾取参考实体"<br />     entobj.GETXDATA "", xtypeOut, xdataOut<br />     tmp=""<br />     If IsArray(xdataOut) = True Then<br />     For i = LBound(xdataOut) To UBound(xdataOut)<br />     If xtypeOut(i) = 1011 Then<br />     tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i)(0) & " " & xdataOut(i)(1) & " " & xdataOut(i)(2) & vbLf<br />     Else<br />     tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i) & vbLf<br />     End If<br />     Next<br />     acadapp.ActiveDocument.Utility.Prompt "扩展数据：" & vbLf & tmp & vbLf<br />     End If<br />     If Len(tmp) = 0 Then acadapp.ActiveDocument.Utility.Prompt "此对象无扩展数据！" & vbLf

dong20030432

看来用扩展数据的人非常少呀！

zyxceng

感谢分享，学习了

yzg_208

不能用在1000以下，确实没多少用