[求助]请教版主：VBA删除实体XDATA属性值

mycad

请教高手：VBA删除实体XDATA属性值问题，下面是在明经网站搜到的，怎末删除不了南方CASS实体的属性值呢？有没有比下面的还好用的函数呢，谢谢！！！！！

'参数:
'Obj: 一个AcadObject?
'RegApp: 已经注册的应用名 (可选)'
'注意:
'1如果未指定应用名，则删除所有的扩展数据。
'2.该函数将不能删除AutoCAD本身的扩展数据
'示例:
'Call ClearXData(myAcadObject, "MCCAD")
'http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=298

 ublic Sub WJSZClearXdata(Obj As AcadObject, Optional RegApp As String = "")
    Const regAppKey As Integer = 1001
    Const acadApp As String = "ACAD"
   
    Dim XDType As Variant
    Dim XDData As Variant
    Dim NewType(0) As Integer
    Dim NewData(0) As Variant
    Dim i As Integer
   
    Obj.GetXData appName:=RegApp, xdatatype:=XDType, XDataValue:=XDData
   
    If Not IsEmpty(XDType) Then
        For i = LBound(XDType) To UBound(XDType)
            If XDType(i) = regAppKey Then
                If Not XDData(i) Like acadApp Then
                    NewType(0) = regAppKey
                    NewData(0) = XDData(i)
                    Obj.SetXData xdatatype:=NewType, XDataValue:=NewData
                End If
            End If
        Next i
    End If
End Sub

mycad

没有人知道吗？

mycad

这么多网友看了，没人回复吗，只能麻烦版主了，先谢谢了！！1

wylong

关键在Call ClearXData(myAcadObject, "MCCAD")中的"MCCAD"，也就是要改成南方CASS定义的程序名。

金色的烟

原打算在绘图时添加些内容，但不知为何一直出错，正好借mycad兄的帖子，一事不烦2主了！

setname 的问题 是：提供的输入无效。请重新检查输入并重试。

我试过2个变量如dt(0 to 1)...,就通过了！

Sub SetName()
Dim Ent As AcadEntity, pt, dt(0 To 2) As Integer, Str(0 To 2)
dt(0) = 1001: dt(1) = 1002: dt(2) = 1003
With ThisDrawing.Utility
.GetEntity Ent, pt, "赋名对象：》"
Str(0) = "水线": Str(1) = "200sx": Str(2) = "30mm"
'Str(1) = .GetString(False, "对象名称：》")
'Str(2) = .GetString(False, "对象厚度：》")
End With
 
Ent.SetXData dt, Str
End Sub

getname 问题:直接报错及退出cad

Sub GetName()
Dim Ent As AcadEntity, pt, dt, Str, tep, Mystr$
ThisDrawing.Utility.GetEntity Ent, pt, "取值对象：》"
Ent.GetXData "", dt, Str
If VarType(Str) <> vbEmpty Then
For Each tep In Str
Mystr = Mystr & vbCrLf & tep
               
            Next
        End If
ThisDrawing.Utility.Prompt Mystr
End Sub

mycad

dt(1) = 1002: dt(2) = 1003可能出问题了，应该为dt(1) = 1000: dt(2) = 1000；改后再试试看。

金色的烟

谢谢，好像可以了

mycad

上次上传数据没有成功，不好意思，现在有了

mycad

解决了，找出成图软件的注册名，再删除xdata属性值就可以了，要注意成图软件的注册名可能有好几个的。