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

mycad 发表于 2009-10-30 14:37:00

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

请教高手：VBA删除实体XDATA属性值问题，下面是在乐筑天下网站搜到的，怎末删除不了南方CASS实体的属性值呢？有没有比下面的还好用的函数呢，谢谢！！！！！
'参数:
'Obj: 一个AcadObject?
'RegApp: 已经注册的应用名 (可选)'
'注意:
'1如果未指定应用名，则删除所有的扩展数据。
'2.该函数将不能删除本身的扩展数据
'示例:
'Call ClearXData(myAcadObject, "MCCAD")
'http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=298
&nbspublic 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
**** Hidden Message *****

mycad 发表于 2009-11-2 06:57:00

没有人知道吗？

mycad 发表于 2009-11-2 16:59:00

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

wylong 发表于 2009-11-3 11:20:00

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

金色的烟 发表于 2009-11-3 20:15:00

原打算在绘图时添加些内容，但不知为何一直出错，正好借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 发表于 2009-11-4 16:35:00

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

金色的烟 发表于 2009-11-5 09:42:00

谢谢，好像可以了

mycad 发表于 2009-11-5 14:55:00

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

mycad 发表于 2009-11-6 07:49:00

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

页: [1]

乐筑天下's Archiver

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