[求助]：请教efan2000，如何在VBA里面存取LDATA数据？

烛光

请教efan2000，如何在VBA里面存取LDATA数据？

efan2000

不知你指的是不是XDATA数据。

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Sub Test()
   
6.     ' 创建直线
   
7.     Dim lineObj As AcadLine
   
8.     Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
   
9.     startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
   
10.     endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
    
11.     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    
12.     ' 创建扩展数据
    
13.     Dim DataType(0 To 1) As Integer
    
14.     Dim Data(0 To 1) As Variant
    
15.     Dim reals3(0 To 2) As Double
    
16.     Dim worldPos(0 To 2) As Double
    
17.     DataType(0) = 1001: Data(0) = "Test_Application" '应用程序名
    
18.     DataType(1) = 1000: Data(1) = "This is a test for xdata" '字符串类型
    
19.     lineObj.SetXData DataType, Data '设置扩展数据
    
20.     ' 返回直线的扩展数据
    
21.     Dim xdataOut As Variant
    
22.     Dim xtypeOut As Variant
    
23.     lineObj.GetXData "Test_Application", xtypeOut, xdataOut
    
24. End Sub
    
25.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Sub Test()<br />     ' 创建直线<br />     Dim lineObj As AcadLine<br />     Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double<br />     startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#<br />     endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#<br />     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)<br />     ' 创建扩展数据<br />     Dim DataType(0 To 1) As Integer<br />     Dim Data(0 To 1) As Variant<br />     Dim reals3(0 To 2) As Double<br />     Dim worldPos(0 To 2) As Double<br />     DataType(0) = 1001: Data(0) = "Test_Application" '应用程序名<br />     DataType(1) = 1000: Data(1) = "This is a test for xdata" '字符串类型<br />     lineObj.SetXData DataType, Data '设置扩展数据<br />     ' 返回直线的扩展数据<br />     Dim xdataOut As Variant<br />     Dim xtypeOut As Variant<br />     lineObj.GetXData "Test_Application", xtypeOut, xdataOut<br /> End Sub<br />   [/FONT]<br />

灯火

LDATA，顾名思义是AutoDesk窝藏私心，专门给lisp留用的数据。当vlax-ldata-put第一个参数为指定全局词典的字符串时，VBA可以通过命名词典“看到”数据，当第一个参数为图元对象时，VBA只能判断出实体具有扩展词典，但“看不到”数据，所以目前还只能用vlax-ldata-**族函数处理LDATA，VBA存取不行。你是想要在Vlisp和VBA之间传递数据吧？可以找点别的办法，在DWG内部，Vlisp、VBA、ARX之间可以传递多达2GB数据。

XDSoft

最初由 灯火 发布
[B]LDATA，顾名思义是AutoDesk窝藏私心，专门给lisp留用的数据，即没有保存在命名词典，也没有保存在实体的扩展词典中，目前还只能用vlax-ldata-**族函数处理，VBA存取没门。你是想要在Vlisp和VBA之间传递数据吧？可以?.. [/B]

哥哥，那你说保存在哪里了呢？:c :c

灯火

XD老弟，LDATA保存在DWG中是无疑的，只是地点没有“暴露”给VBA，所以VBA无法存取，这和其他一些第三方程序自定对象数据不能存取是一个道理。类似的东西还有一些，实际上这是因为AutoCAD对象模型还不够完善。如果有朝一日AutoCAD能像Office一样录制宏，则对象模型才算确定。这个LDATA对于使用VL和VBA混合编程并需要在两者之间传递数据的人有些误导作用。

XDSoft

：）拿试验来说话


下载地址：http://www.xdcad.net/tech/dev/ldata-1.swf

<embed src=http://www.xdcad.net/tech/dev/ldata-1.swf quality=high width=512 height=482 loop=true type="application/x-shockwave-flash">
</embed>

所以，既然保存在命名词典根下，就有办法得到它，用VLISP,VBA,ARX

黄卫文

最初由 XDSoft 发布
[B]：）拿试验来说话
[/B]

晓东把它们之间的联系方法说清楚点嘛，我想。。。

最初由 灯火 发布
[B]：）你是想要在Vlisp和VBA之间传递数据吧？可以找点别的办法，在DWG内部，Vlisp、VBA、ARX之间可以传递多达2GB数据。
[/B]

灯火：你能告诉我传递的方法吗？我好想知道！！

XDSoft

最初由 黄卫文 发布
[B]

晓东把它们之间的联系方法说清楚点嘛，我想。。。

[QUOTE]最初由 灯火 发布
[B]：）你是想要在Vlisp和VBA之间传递数据吧？可?.. [/B]

大家注意了上面图中的XDTB_TEST项最后的vlo_VL了吗？

VLISP的LDATA数据附着在一个名字为vlo_VL的类的定制对象，并和这个对象一起添加到命名对象词典中。但是，这个自定义对象不能单独的借助用VBA的对象模型存取，不能用VBA创建自定义对象、实体。只能通过ObjectARX创建一个ActiveX接口，才能让VBA使用它。目前并没有直接的接口或者Automation server直接使用。

但是，AutoCAD 2000 Visual LISP Automation server 有一个未公开支持的接口，可以作为VBA宏和LISP环境的搭桥，进行相互间数据的存取。

下面代码演示了如何用VBA读VLISP的LDATA数据。

卫文、灯火哥哥和大家再继续讨论讨论吧。

游客，如果您要查看本帖隐藏内容请回复

灯火

To XD：演示做得好快！旁边那个东西是ARX写的吧？当然不会有问题，试一下把LDATA附加给实体，它也也显示得很好，但VBA却不容易识别。

To 黄卫文：VL.Application的方法虽然可行，和vla-Eval调用VBA函数一样，不是十分“正经”。应该让Vlisp和VBA各做其擅长的事情而无需论其长短，二者需要传递数据时用Dictionary和Xrecord更为舒畅自然。

XDSoft

最初由 灯火 发布
[B]To XD：演示做得好快！旁边那个东西是ARX写的吧？当然不会有问题，试一下把LDATA附加给实体，它也也显示得很好，但VBA却不容易识别。

To 黄卫文：VL.Application的方法虽然可行，和vla-Eval调用VBA函数一样，不是... [/B]

教你，你也不学：），演示就是捕捉下输入，几分钟的事情。

旁边那个东西，是INSPECTOR工具，论坛提供给大家了，可以看到ACAD数据库内部的秘密。不是因为是ARX写的，就能看到，而是通过它，知道LDATA准确的存放位置（在词典中），不读，LDATA也是放在那里：），只是LDATA是和一个自定义对象捆绑，就如非实体数据通过“扩展记录XRecord捆绑，才能放入词典中一样，因为词典中的对象，必须是AcDbObject类派生的。

不管什么，能通讯就可以了，不行的话，就用ARX吧。

灯火，你说可以传递2GB数据，能说说吗，给大家？

灯火

Xrecord是一个任意数据的容器，它提供了比xdata更灵活的附加数据的办法，Xrecord能包含2GB的任意数据，特别适合不同开发语言之间传递数据，有用的保留在DWG，临时的完事就删除。有时VBA和Excel交互大量数据，完成计算，生成图形时Vlisp又方便一些，如果双方代码都比较长就不适合VL.Application方法，那种方法让人眼花缭乱，不如把数据传递过去，用Vlisp干干净净地写。

XDSoft

最初由 灯火 发布
[B]Xrecord是一个任意数据的容器，它提供了比xdata更灵活的附加数据的办法，Xrecord能包含2GB的任意数据，特别适合不同开发语言之间传递数据，有用的保留在DWG，临时的完事就删除。有时VBA和Excel交互大量数据，完成计?.. [/B]

不谋而合，灯火，能给大家贴个实例，讲讲VBA如何把数据写到XRecord,LISP又是如何提取处理的代码吗？先谢谢了。

灯火

** 1-VBA传出

2. 
   
3. [FONT=courier new]
   
4. '
   
5. '设置指定词典扩展记录
   
6. '
   
7. Public Function Dhvb_SetXrecord(objDict As AcadDictionary, _
   
8.                                 XRecordName As String, _
   
9.                                 XRecordData As Variant) _
   
10.        As AcadXRecord
    
11. 
    
12.     Dim objXRecord As AcadXRecord
    
13.     Dim XRecordType As Variant
    
14.     Dim i As Long
    
15. 
    
16.     '检察对象词典是否有该名扩展记录,如果已经存在则删除
    
17.     On Error Resume Next
    
18.     Set objXRecord = objDict.GetObject(XRecordName)
    
19.     If Not objXRecord Is Nothing Then
    
20.         objDict.Remove XRecordName
    
21.     End If
    
22.     On Error GoTo 0
    
23. 
    
24.     '建立扩展记录数据
    
25.     ReDim XRecordType(0 To UBound(XRecordData)) As Integer
    
26.     For i = 0 To UBound(XRecordData)
    
27. 
    
28.         Select Case VarType(XRecordData(i))
    
29. 
    
30.             Case vbInteger, vbLong
    
31.                 XRecordType(i) = 90    '整数组码=90
    
32. 
    
33.             Case vbSingle, vbDouble
    
34.                 XRecordType(i) = 40    '实数组码=40
    
35. 
    
36.             Case vbString
    
37.                 XRecordType(i) = 2    '字符组码=2
    
38. 
    
39.         End Select
    
40. 
    
41.     Next
    
42. 
    
43.     '添加扩展记录到对象词典
    
44.     Set objXRecord = objDict.AddXRecord(XRecordName)
    
45.     objXRecord.SetXRecordData XRecordType, XRecordData
    
46. 
    
47.     '返回扩展记录对象
    
48.     Set Dhvb_SetXrecord = objXRecord
    
49. 
    
50. End Function
    

<br /> [FONT=courier new]<br /> '<br /> '设置指定词典扩展记录<br /> '<br /> Public Function Dhvb_SetXrecord(objDict As AcadDictionary, _<br />                                 XRecordName As String, _<br />                                 XRecordData As Variant) _<br />        As AcadXRecord<br /> <br />     Dim objXRecord As AcadXRecord<br />     Dim XRecordType As Variant<br />     Dim i As Long<br /> <br />     '检察对象词典是否有该名扩展记录,如果已经存在则删除<br />     On Error Resume Next<br />     Set objXRecord = objDict.GetObject(XRecordName)<br />     If Not objXRecord Is Nothing Then<br />         objDict.Remove XRecordName<br />     End If<br />     On Error GoTo 0<br /> <br />     '建立扩展记录数据<br />     ReDim XRecordType(0 To UBound(XRecordData)) As Integer<br />     For i = 0 To UBound(XRecordData)<br /> <br />         Select Case VarType(XRecordData(i))<br /> <br />             Case vbInteger, vbLong<br />                 XRecordType(i) = 90    '整数组码=90<br /> <br />             Case vbSingle, vbDouble<br />                 XRecordType(i) = 40    '实数组码=40<br /> <br />             Case vbString<br />                 XRecordType(i) = 2    '字符组码=2<br /> <br />         End Select<br /> <br />     Next<br /> <br />     '添加扩展记录到对象词典<br />     Set objXRecord = objDict.AddXRecord(XRecordName)<br />     objXRecord.SetXRecordData XRecordType, XRecordData<br /> <br />     '返回扩展记录对象<br />     Set Dhvb_SetXrecord = objXRecord<br /> <br /> End Function<br />

** 2-Vlisp读取

2. 
   
3. ;;;======================================================================;
   
4. ;;;读取指定词典扩展记录,返回数据表                                       ;
   
5. ;;;======================================================================;
   
6. (defun Dhvl_GetXrecord (objDict           XRedName   /                 objXRed
   
7.                         XRedType   XRedData   TypeList         DataList
   
8.                         x
   
9.                        )
   
10.   (setq objXRed (vla-GetObject objDict XRedName))
    
11.   (vla-GetXRecordData objXRed 'XRedType 'XRedData)
    
12.   (setq        XRedType (vlax-safearray->list XRedType)
    
13.         XRedData (vlax-safearray->list XRedData)
    
14.   )
    
15.   (foreach x XRedType
    
16.     (setq TypeList (append TypeList (list x)))
    
17.   )
    
18.   (foreach x XRedData
    
19.     (setq DataList (append DataList (list (vlax-variant-value x))))
    
20.   )
    
21.   (list TypeList DataList)
    
22. )
    
23. [/FONT]

<br /> ;;;======================================================================;<br /> ;;;读取指定词典扩展记录,返回数据表                                       ;<br /> ;;;======================================================================;<br /> (defun Dhvl_GetXrecord (objDict           XRedName   /                 objXRed<br />                         XRedType   XRedData   TypeList         DataList<br />                         x<br />                        )<br />   (setq objXRed (vla-GetObject objDict XRedName))<br />   (vla-GetXRecordData objXRed 'XRedType 'XRedData)<br />   (setq        XRedType (vlax-safearray->list XRedType)<br />         XRedData (vlax-safearray->list XRedData)<br />   )<br />   (foreach x XRedType<br />     (setq TypeList (append TypeList (list x)))<br />   )<br />   (foreach x XRedData<br />     (setq DataList (append DataList (list (vlax-variant-value x))))<br />   )<br />   (list TypeList DataList)<br /> )<br /> [/FONT]

XDSoft

最初由 灯火 发布
[B]** 1-VBA传出
[code]

'
'设置指定词典扩展记录
'
Public Function Dhvb_SetXrecord(objDict As AcadDictionary, _
                                XRecordName As String, _
         ... [/B]

灯火，那你在VLISP里面，很少用LDATA了？

efan2000

LData称为私有数据，那么能不能保护自己的数据，而不被其它程序读取，即使用被人知道了字典（Dict）和关键字（Key）。