dong20030432 发表于 2018-4-19 13:01:16

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

分享一段获取CAD对象扩展数据的小代码，请高手批评指正，谢谢！！！
   
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    Dim acadapp as object
    Dim entobj as object
    Dim BasePnt As Variant
    Dim tmp As String
    Dim i As Long
    On Error Resume Next
    AppActivate acadapp.Caption
    acadapp.ActiveDocument.Utility.GetEntity entobj, BasePnt, "请拾取参考实体"
    entobj.GETXDATA "", xtypeOut, xdataOut
    tmp=""
    If IsArray(xdataOut) = True Then
    For i = LBound(xdataOut) To UBound(xdataOut)
    If xtypeOut(i) = 1011 Then
    tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i)(0) & " " & xdataOut(i)(1) & " " & xdataOut(i)(2) & vbLf
    Else
    tmp = tmp & i & " " & xtypeOut(i) & " " & xdataOut(i) & vbLf
    End If
    Next
    acadapp.ActiveDocument.Utility.Prompt "扩展数据：" & vbLf & tmp & vbLf
    End If
    If Len(tmp) = 0 Then acadapp.ActiveDocument.Utility.Prompt "此对象无扩展数据！" & vbLf

dong20030432 发表于 2018-4-25 16:05:07

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

zyxceng 发表于 2018-11-20 22:06:58

感谢分享，学习了

yzg_208 发表于 2019-7-27 15:07:31

不能用在1000以下，确实没多少用
页: [1]
查看完整版本: 分享一段VB获取CAD对象扩展数据的小代码