[分享]：在Vlisp和VBA之间传递数据

wowoaicad

2. 在Vlisp和VBA之间传递数据  
   
3. 
   
4. 来源：  明经通道 　作(译)者：  河伯 　
   
5. 
   
6. LDATA，顾名思义是AutoDesk窝藏私心，专门给lisp留用的数据。当vlax-ldata-put第一个参数为指定全局词典的字符串时，
   
7. VBA可以通过命名词典“看到”数据，当第一个参数为图元对象时，VBA只能判断出实体具有扩展词典，但“看不到”
   
8. 数据，所以目前还只能用vlax-ldata-**族函数处理LDATA，VBA存取不行。你是想要在Vlisp和VBA之间传递数据吧？可以
   
9. 找点别的办法，在DWG内部，Vlisp、VBA、ARX之间可以传递多达2GB数据。
   
10.     LDATA保存在DWG中是无疑的，只是地点没有“暴露”给VBA，所以VBA无法存取，这和其他一些第三方程序
    
11. 自定对象数据不能存取是一个道理，类似的东西还有一些，这个LDATA对于使用VL和VBA混合编程并需要在两者之
    
12. 间传递数据的人有些误导作用。
    
13.     应该让Vlisp和VBA各做其擅长的事情而无需论其长短，二者需要传递数据时用Dictionary和Xrecord更为舒畅自然。
    
14. Xrecord是一个任意数据的容器，它提供了比xdata更灵活的附加数据的办法，Xrecord能包含2GB的任意数据，特别
    
15. 合不同开发语言之间传递数据，有用的保留在DWG，临时的完事就删除。
    
16. 有时VBA和Excel交互大量数据，完成计算，生成图形时Vlisp又方便一些，VBa把数据传递过去，用Vlisp干干净净地写，
    
17. 反之亦然。
    
18. 
    
19. ** 1-VBA传出
    
20. 
    
21. '
    
22. '设置指定词典扩展记录
    
23. '
    
24. Public Function Dhvb_SetXrecord(objDict As AcadDictionary, _
    
25.                                 XRecordName As String, _
    
26.                                 XRecordData As Variant) _
    
27.        As AcadXRecord
    
28. 
    
29.     Dim objXRecord As AcadXRecord
    
30.     Dim XRecordType As Variant
    
31.     Dim i As Long
    
32. 
    
33.     '检察对象词典是否有该名扩展记录,如果已经存在则删除
    
34.     On Error Resume Next
    
35.     Set objXRecord = objDict.GetObject(XRecordName)
    
36.     If Not objXRecord Is Nothing Then
    
37.         objDict.Remove XRecordName
    
38.     End If
    
39.     On Error GoTo 0
    
40. 
    
41.     '建立扩展记录数据
    
42.     ReDim XRecordType(0 To UBound(XRecordData)) As Integer
    
43.     For i = 0 To UBound(XRecordData)
    
44. 
    
45.         Select Case VarType(XRecordData(i))
    
46. 
    
47.             Case vbInteger, vbLong
    
48.                 XRecordType(i) = 90    '整数组码=90
    
49. 
    
50.             Case vbSingle, vbDouble
    
51.                 XRecordType(i) = 40    '实数组码=40
    
52. 
    
53.             Case vbString
    
54.                 XRecordType(i) = 2    '字符组码=2
    
55. 
    
56.         End Select
    
57. 
    
58.     Next
    
59. 
    
60.     '添加扩展记录到对象词典
    
61.     Set objXRecord = objDict.AddXRecord(XRecordName)
    
62.     objXRecord.SetXRecordData XRecordType, XRecordData
    
63. 
    
64.     '返回扩展记录对象
    
65.     Set Dhvb_SetXrecord = objXRecord
    
66. 
    
67. End Function
    
68. 
    
69. 
    
70. ** 2-Vlisp读取
    
71. 
    
72. 
    
73. ;;;
    
74. ;;;读取指定词典扩展记录,返回数据表                                       ;
    
75. ;;;
    
76. (defun Dhvl_GetXrecord (objDict    XRedName   / objXRed
    
77. XRedType   XRedData   TypeList DataList
    
78. x
    
79.        )
    
80.   (setq objXRed (vla-GetObject objDict XRedName))
    
81.   (vla-GetXRecordData objXRed 'XRedType 'XRedData)
    
82.   (setq XRedType (vlax-safearray->list XRedType)
    
83. XRedData (vlax-safearray->list XRedData)
    
84.   )
    
85.   (foreach x XRedType
    
86.     (setq TypeList (append TypeList (list x)))
    
87.   )
    
88.   (foreach x XRedData
    
89.     (setq DataList (append DataList (list (vlax-variant-value x))))
    
90.   )
    
91.   (list TypeList DataList)
    
92. )
    
93. 
    

在Vlisp和VBA之间传递数据  <br /> <br /> 来源：  明经通道 　作(译)者：  河伯 　<br /> <br /> LDATA，顾名思义是AutoDesk窝藏私心，专门给lisp留用的数据。当vlax-ldata-put第一个参数为指定全局词典的字符串时，<br /> VBA可以通过命名词典“看到”数据，当第一个参数为图元对象时，VBA只能判断出实体具有扩展词典，但“看不到”<br /> 数据，所以目前还只能用vlax-ldata-**族函数处理LDATA，VBA存取不行。你是想要在Vlisp和VBA之间传递数据吧？可以<br /> 找点别的办法，在DWG内部，Vlisp、VBA、ARX之间可以传递多达2GB数据。 <br />     LDATA保存在DWG中是无疑的，只是地点没有“暴露”给VBA，所以VBA无法存取，这和其他一些第三方程序<br /> 自定对象数据不能存取是一个道理，类似的东西还有一些，这个LDATA对于使用VL和VBA混合编程并需要在两者之<br /> 间传递数据的人有些误导作用。 <br />     应该让Vlisp和VBA各做其擅长的事情而无需论其长短，二者需要传递数据时用Dictionary和Xrecord更为舒畅自然。<br /> Xrecord是一个任意数据的容器，它提供了比xdata更灵活的附加数据的办法，Xrecord能包含2GB的任意数据，特别<br /> 合不同开发语言之间传递数据，有用的保留在DWG，临时的完事就删除。<br /> 有时VBA和Excel交互大量数据，完成计算，生成图形时Vlisp又方便一些，VBa把数据传递过去，用Vlisp干干净净地写，<br /> 反之亦然。 <br /> <br /> ** 1-VBA传出 <br /> <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 /> <br /> <br /> ** 2-Vlisp读取 <br /> <br /> <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 /> <br />

lijiao

在http://www.xdcad.net/forum/showt ... 5中已经有了。