[转贴]：VLAX类库

efan2000

提供Lisp接口，增强VBA的开发功能。以下是调用前应注意的。

2. 
   
3.   [FONT=courier new]
   
4. AutoCAD 或 Visual LISP 启动时并没有自动加载 ActiveX 功能，所以，如果要使用 ActiveX，就必须确保已加载了 ActiveX。下述函数可以完成该任务：
   
5. 
   
6. (vl-load-com)
   
7. 
   
8. 如果没有加载 ActiveX 支持程序，那么运行 vl-load-com 可以初始化 AutoLISP ActiveX 环境。如果已加载 ActiveX，vl-load-com 将不做任何工作。
   
9.   [/FONT]
   

<br />   [FONT=courier new]<br /> AutoCAD 或 Visual LISP 启动时并没有自动加载 ActiveX 功能，所以，如果要使用 ActiveX，就必须确保已加载了 ActiveX。下述函数可以完成该任务：<br /> <br /> (vl-load-com) <br /> <br /> 如果没有加载 ActiveX 支持程序，那么运行 vl-load-com 可以初始化 AutoLISP ActiveX 环境。如果已加载 ActiveX，vl-load-com 将不做任何工作。<br />   [/FONT]<br />

2. 
   
3.   [FONT=courier new]
   
4. VERSION 1.0 CLASS
   
5. BEGIN
   
6.   MultiUse = -1  'True
   
7. END
   
8. Attribute VB_Name = "VLAX"
   
9. Attribute VB_GlobalNameSpace = False
   
10. Attribute VB_Creatable = False
    
11. Attribute VB_PredeclaredId = False
    
12. Attribute VB_Exposed = False
    
13. ' VLAX.CLS v1.4 (Last updated 8/27/2001)
    
14. ' Copyright 1999-2001 by Frank Oquendo
    
15. '
    
16. ' Permission to use, copy, modify, and distribute this software
    
17. ' for any purpose and without fee is hereby granted, provided
    
18. ' that the above copyright notice appears in all copies and
    
19. ' that both that copyright notice and the limited warranty and
    
20. ' restricted rights notice below appear in all supporting
    
21. ' documentation.
    
22. '
    
23. ' FRANK OQUENDO (THE AUTHOR) PROVIDES THIS PROGRAM "AS IS" AND WITH
    
24. ' ALL FAULTS. THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY
    
25. ' OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  THE AUTHOR
    
26. ' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
    
27. ' UNINTERRUPTED OR ERROR FREE.
    
28. '
    
29. ' Use, duplication, or disclosure by the U.S. Government is subject to
    
30. ' restrictions set forth in FAR 52.227-19 (Commercial Computer
    
31. ' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
    
32. ' (Rights in Technical Data and Computer Software), as applicable.
    
33. '
    
34. ' VLAX.cls allows developers to evaluate AutoLISP expressions from
    
35. ' Visual Basic or VBA
    
36. '
    
37. ' Notes:
    
38. ' All code for this class module is publicly available througout various posts
    
39. ' at [url]news://discussion.autodesk.com/autodesk.autocad.customization.vba.[/url] I do not
    
40. ' claim copyright or authorship on code presented in these posts, only on this
    
41. ' compilation of that code. In addition, a great big "Thank you!" to Cyrille Fauvel
    
42. ' demonstrating the use of the VisualLISP ActiveX Module.
    
43. '
    
44. ' Dependencies:
    
45. ' Use of this class module requires the following application:
    
46. ' 1. VisualLISP
    
47. 
    
48. Private VL As Object
    
49. Private VLF As Object
    
50. 
    
51. Private Sub Class_Initialize()
    
52. 
    
53.     Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
    
54.     Set VLF = VL.ActiveDocument.Functions
    
55. 
    
56. End Sub
    
57. 
    
58. Private Sub Class_Terminate()
    
59. 
    
60.     Set VLF = Nothing
    
61.     Set VL = Nothing
    
62. 
    
63. End Sub
    
64. 
    
65. Public Function EvalLispExpression(lispStatement As String)
    
66. 
    
67.     Dim sym As Object, ret As Object, retval
    
68.    
    
69.     Set sym = VLF.Item("read").funcall(lispStatement)
    
70.     On Error Resume Next
    
71.     retval = VLF.Item("eval").funcall(sym)
    
72.     If Err Then
    
73.         EvalLispExpression = ""
    
74.     Else
    
75.         EvalLispExpression = retval
    
76.     End If
    
77. 
    
78. End Function
    
79. 
    
80. Public Sub SetLispSymbol(symbolName As String, value)
    
81. 
    
82.     Dim sym As Object, ret, symValue
    
83.    
    
84.     symValue = value
    
85.     Set sym = VLF.Item("read").funcall(symbolName)
    
86.     ret = VLF.Item("set").funcall(sym, symValue)
    
87.     EvalLispExpression "(defun translate-variant (data) (cond ((= (type data) 'list) (mapcar 'translate-variant data)) ((= (type data) 'variant)
    
88. (translate-variant (vlax-variant-value data))) ((= (type data) 'safearray) (mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"
    
89.     EvalLispExpression "(setq " & symbolName & "(translate-variant " & symbolName & "))"
    
90.     EvalLispExpression "(setq translate-variant nil)"
    
91. 
    
92. End Sub
    
93. 
    
94. Public Function GetLispSymbol(symbolName As String)
    
95. 
    
96.     Dim sym As Object, ret, symValue
    
97.    
    
98.     symValue = value
    
99.     Set sym = VLF.Item("read").funcall(symbolName)
    
100.     GetLispSymbol = VLF.Item("eval").funcall(sym)
     
101. 
     
102. End Function
     
103. 
     
104. Public Function GetLispList(symbolName As String) As Variant
     
105. 
     
106.    Dim sym As Object, list As Object
     
107.    Dim Count, elements(), i As Long
     
108.    
     
109.    Set sym = VLF.Item("read").funcall(symbolName)
     
110.    Set list = VLF.Item("eval").funcall(sym)
     
111.    
     
112.    Count = VLF.Item("length").funcall(list)
     
113.    
     
114.    ReDim elements(0 To Count - 1) As Variant
     
115.    
     
116.    For i = 0 To Count - 1
     
117.         elements(i) = VLF.Item("nth").funcall(i, list)
     
118.    Next
     
119.    
     
120.    GetLispList = elements
     
121.    
     
122. End Function
     
123. 
     
124. Public Sub NullifySymbol(ParamArray symbolName())
     
125. 
     
126.     Dim i As Integer
     
127.    
     
128.     For i = LBound(symbolName) To UBound(symbolName)
     
129.         EvalLispExpression "(setq " & CStr(symbolName(i)) & " nil)"
     
130.     Next
     
131. 
     
132. End Sub
     
133. 
     
134.   [/FONT]
     

<br />   [FONT=courier new]<br /> VERSION 1.0 CLASS<br /> BEGIN<br />   MultiUse = -1  'True<br /> END<br /> Attribute VB_Name = "VLAX"<br /> Attribute VB_GlobalNameSpace = False<br /> Attribute VB_Creatable = False<br /> Attribute VB_PredeclaredId = False<br /> Attribute VB_Exposed = False<br /> ' VLAX.CLS v1.4 (Last updated 8/27/2001)<br /> ' Copyright 1999-2001 by Frank Oquendo<br /> '<br /> ' Permission to use, copy, modify, and distribute this software<br /> ' for any purpose and without fee is hereby granted, provided<br /> ' that the above copyright notice appears in all copies and<br /> ' that both that copyright notice and the limited warranty and<br /> ' restricted rights notice below appear in all supporting<br /> ' documentation.<br /> '<br /> ' FRANK OQUENDO (THE AUTHOR) PROVIDES THIS PROGRAM "AS IS" AND WITH<br /> ' ALL FAULTS. THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY<br /> ' OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  THE AUTHOR<br /> ' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE<br /> ' UNINTERRUPTED OR ERROR FREE.<br /> '<br /> ' Use, duplication, or disclosure by the U.S. Government is subject to<br /> ' restrictions set forth in FAR 52.227-19 (Commercial Computer<br /> ' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)<br /> ' (Rights in Technical Data and Computer Software), as applicable.<br /> '<br /> ' VLAX.cls allows developers to evaluate AutoLISP expressions from<br /> ' Visual Basic or VBA<br /> '<br /> ' Notes:<br /> ' All code for this class module is publicly available througout various posts<br /> ' at [url]news://discussion.autodesk.com/autodesk.autocad.customization.vba.[/url] I do not<br /> ' claim copyright or authorship on code presented in these posts, only on this<br /> ' compilation of that code. In addition, a great big "Thank you!" to Cyrille Fauvel<br /> ' demonstrating the use of the VisualLISP ActiveX Module.<br /> '<br /> ' Dependencies:<br /> ' Use of this class module requires the following application:<br /> ' 1. VisualLISP<br /> <br /> Private VL As Object<br /> Private VLF As Object<br /> <br /> Private Sub Class_Initialize()<br /> <br />     Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")<br />     Set VLF = VL.ActiveDocument.Functions<br /> <br /> End Sub<br /> <br /> Private Sub Class_Terminate()<br /> <br />     Set VLF = Nothing<br />     Set VL = Nothing<br /> <br /> End Sub<br /> <br /> Public Function EvalLispExpression(lispStatement As String)<br /> <br />     Dim sym As Object, ret As Object, retval<br />     <br />     Set sym = VLF.Item("read").funcall(lispStatement)<br />     On Error Resume Next<br />     retval = VLF.Item("eval").funcall(sym)<br />     If Err Then<br />         EvalLispExpression = ""<br />     Else<br />         EvalLispExpression = retval<br />     End If<br /> <br /> End Function<br /> <br /> Public Sub SetLispSymbol(symbolName As String, value)<br /> <br />     Dim sym As Object, ret, symValue<br />     <br />     symValue = value<br />     Set sym = VLF.Item("read").funcall(symbolName)<br />     ret = VLF.Item("set").funcall(sym, symValue)<br />     EvalLispExpression "(defun translate-variant (data) (cond ((= (type data) 'list) (mapcar 'translate-variant data)) ((= (type data) 'variant) <br /> (translate-variant (vlax-variant-value data))) ((= (type data) 'safearray) (mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"<br />     EvalLispExpression "(setq " & symbolName & "(translate-variant " & symbolName & "))"<br />     EvalLispExpression "(setq translate-variant nil)"<br /> <br /> End Sub<br /> <br /> Public Function GetLispSymbol(symbolName As String)<br /> <br />     Dim sym As Object, ret, symValue<br />     <br />     symValue = value<br />     Set sym = VLF.Item("read").funcall(symbolName)<br />     GetLispSymbol = VLF.Item("eval").funcall(sym)<br /> <br /> End Function<br /> <br /> Public Function GetLispList(symbolName As String) As Variant<br /> <br />    Dim sym As Object, list As Object<br />    Dim Count, elements(), i As Long<br />    <br />    Set sym = VLF.Item("read").funcall(symbolName)<br />    Set list = VLF.Item("eval").funcall(sym)<br />    <br />    Count = VLF.Item("length").funcall(list)<br />    <br />    ReDim elements(0 To Count - 1) As Variant<br />    <br />    For i = 0 To Count - 1<br />         elements(i) = VLF.Item("nth").funcall(i, list)<br />    Next<br />    <br />    GetLispList = elements<br />    <br /> End Function<br /> <br /> Public Sub NullifySymbol(ParamArray symbolName())<br /> <br />     Dim i As Integer<br />     <br />     For i = LBound(symbolName) To UBound(symbolName)<br />         EvalLispExpression "(setq " & CStr(symbolName(i)) & " nil)"<br />     Next<br /> <br /> End Sub<br /> <br />   [/FONT]<br />

efan2000

下面的类库扩充了VBA处理曲线类对象的能力。

2. 
   
3.   [FONT=courier new]
   
4. VERSION 1.0 CLASS
   
5. BEGIN
   
6.   MultiUse = -1  'True
   
7. END
   
8. Attribute VB_Name = "Curve"
   
9. Attribute VB_GlobalNameSpace = False
   
10. Attribute VB_Creatable = False
    
11. Attribute VB_PredeclaredId = False
    
12. Attribute VB_Exposed = False
    
13. ' Curve.cls v1.3 (Last updated 12/18/2001)
    
14. ' Copyright 2000, 2001 by Frank Oquendo
    
15. '
    
16. ' Permission to use, copy, modify, and distribute this software
    
17. ' for any purpose and without fee is hereby granted, provided
    
18. ' that the above copyright notice appears in all copies and
    
19. ' that both that copyright notice and the limited warranty and
    
20. ' restricted rights notice below appear in all supporting
    
21. ' documentation.
    
22. '
    
23. ' FRANK OQUENDO (THE AUTHOR) PROVIDES THIS PROGRAM "AS IS" AND WITH
    
24. ' ALL FAULTS. THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY
    
25. ' OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  THE AUTHOR
    
26. ' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
    
27. ' UNINTERRUPTED OR ERROR FREE.
    
28. '
    
29. ' Use, duplication, or disclosure by the U.S. Government is subject to
    
30. ' restrictions set forth in FAR 52.227-19 (Commercial Computer
    
31. ' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
    
32. ' (Rights in Technical Data and Computer Software), as applicable.
    
33. '
    
34. ' Curve.cls allows developers to access the various VLAX-CURVE functions
    
35. ' from Visual Basic or VBA.
    
36. '
    
37. ' Notes:
    
38. ' I do not claim copyright or authorship of the code being wrapped by this module,
    
39. ' only on this compilation of that code.
    
40. '
    
41. ' Dependencies:
    
42. ' Use of this class module requires the following files:
    
43. ' 1. VLAX.CLS - This file can be obtained by visiting [url]http://www.acadx.com[/url]
    
44. 
    
45. Private objVLAX As VLAX
    
46. Private mvarEntity As AcadEntity
    
47. Private types(8) As String
    
48. 
    
49. Private Sub Class_Initialize()
    
50. 
    
51.     Set objVLAX = New VLAX
    
52.     types(0) = "AcDbCircle": types(1) = "AcDbLine"
    
53.     types(2) = "AcDbArc": types(3) = "AcDbSpline"
    
54.     types(4) = "AcDb3dPolyline": types(5) = "AcDbPolyline"
    
55.     types(6) = "AcDb2dPolyline": types(7) = "AcDbEllipse"
    
56.     types(8) = "AcDbLeader"
    
57. 
    
58. End Sub
    
59. 
    
60. Private Sub Class_Terminate()
    
61. 
    
62.     Set objVLAX = Nothing
    
63. 
    
64. End Sub
    
65. 
    
66. Public Property Set Entity(ent As AcadEntity)
    
67. 
    
68.     Dim tmp As String, i As Long, bFound As Boolean
    
69.    
    
70.     tmp = ent.ObjectName
    
71.    
    
72.     For i = 0 To 8
    
73.         If tmp = types(i) Then
    
74.             Set mvarEntity = ent
    
75.             bFound = True
    
76.             Exit For
    
77.         End If
    
78.     Next
    
79.    
    
80.     If Not bFound Then Err.Raise vbObjectError + 1, , "That entity is not a curve."
    
81. 
    
82. End Property
    
83. 
    
84. Public Property Get Entity() As AcadEntity
    
85. 
    
86.     Set entityt = mvarEntity
    
87. 
    
88. End Property
    
89. 
    
90. Public Property Get CurveType() As String
    
91. 
    
92.     CurveType = mvarEntity.ObjectName
    
93. 
    
94. End Property
    
95. 
    
96. Public Property Get Area() As Double
    
97. 
    
98.     Dim retval As Double
    
99.    
    
100.     With objVLAX
     
101.         .SetLispSymbol "handle", mvarEntity.Handle
     
102.         retval = .EvalLispExpression("(vlax-curve-getArea (handent handle))")
     
103.         .NullifySymbol "handle"
     
104.     End With
     
105.     Area = retval
     
106. 
     
107. End Property
     
108. 
     
109. Public Property Get Closed() As Boolean
     
110. 
     
111.     Dim retval As Boolean
     
112.    
     
113.     With objVLAX
     
114.         .SetLispSymbol "handle", mvarEntity.Handle
     
115.         retval = .EvalLispExpression("(vlax-curve-isClosed (handent handle))")
     
116.         .NullifySymbol "handle"
     
117.     End With
     
118.     Closed = retval
     
119. 
     
120. End Property
     
121. 
     
122. Public Property Get EndParameter() As Double
     
123. 
     
124.     Dim retval As Double
     
125.    
     
126.     With objVLAX
     
127.         .SetLispSymbol "handle", mvarEntity.Handle
     
128.         retval = .EvalLispExpression("(vlax-curve-getEndParam (handent handle))")
     
129.         .NullifySymbol "handle"
     
130.     End With
     
131.     EndParameter = retval
     
132. 
     
133. End Property
     
134. 
     
135. Public Property Get EndPoint() As Variant
     
136. 
     
137.     Dim retval As Variant, pt(0 To 2) As Double
     
138.     Dim i As Long
     
139.    
     
140.     With objVLAX
     
141.         .SetLispSymbol "handle", mvarEntity.Handle
     
142.         .EvalLispExpression "(setq lst (vlax-curve-getEndPoint (handent handle)))"
     
143.         retval = .GetLispList("lst")
     
144.         .NullifySymbol "handle", "lst"
     
145.     End With
     
146.    
     
147.     For i = 0 To 2
     
148.         pt(i) = retval(i)
     
149.     Next
     
150.    
     
151.     EndPoint = pt
     
152. 
     
153. End Property
     
154. 
     
155. Public Function GetClosestPointTo(Point, Optional Extend As Boolean = False) As Variant
     
156. 
     
157.     Dim retval As Variant, pt(0 To 2) As Double
     
158.     Dim i As Long
     
159.    
     
160.     With objVLAX
     
161.         .SetLispSymbol "handle", mvarEntity.Handle
     
162.         .SetLispSymbol "givenPt", Point
     
163.         If Extend Then .EvalLispExpression "(setq ext T)"
     
164.         .EvalLispExpression "(setq lst (vlax-curve-getClosestPointTo (handent handle) givenPt ext))"
     
165.         retval = .GetLispList("lst")
     
166.         .NullifySymbol "handle", "lst", "ext", "givenPt"
     
167.     End With
     
168.    
     
169.     For i = 0 To 2
     
170.         pt(i) = retval(i)
     
171.     Next
     
172.    
     
173.     GetClosestPointTo = pt
     
174. 
     
175. End Function
     
176. 
     
177. Public Function GetDistanceAtParameter(Param As Double) As Double
     
178. 
     
179.     Dim retval As Double
     
180.    
     
181.     With objVLAX
     
182.         .SetLispSymbol "handle", mvarEntity.Handle
     
183.         .SetLispSymbol "param", Param
     
184.         retval = .EvalLispExpression("(vlax-curve-getDistAtParam (handent handle) param)")
     
185.         .NullifySymbol "handle", "param"
     
186.     End With
     
187.     GetDistanceAtParameter = retval
     
188. 
     
189. End Function
     
190. 
     
191. Public Function GetDistanceAtPoint(Point As Variant) As Double
     
192. 
     
193.     Dim retval As Double
     
194.    
     
195.     With objVLAX
     
196.         .SetLispSymbol "handle", mvarEntity.Handle
     
197.         .SetLispSymbol "point", Point
     
198.         retval = .EvalLispExpression("(vlax-curve-getDistAtPoint (handent handle) point)")
     
199.         .NullifySymbol "handle", "point"
     
200.     End With
     
201.     GetDistanceAtPoint = retval
     
202. 
     
203. End Function
     
204. 
     
205. Public Function GetFirstDerivative(Param As Double) As Variant
     
206. 
     
207.     Dim retval As Variant
     
208.    
     
209.     With objVLAX
     
210.         .SetLispSymbol "handle", mvarEntity.Handle
     
211.         .SetLispSymbol "param", Param
     
212.         .EvalLispExpression "(setq lst (vlax-curve-getFirstDeriv (handent handle) param))"
     
213.         retval = .GetLispList("lst")
     
214.         .NullifySymbol "handle", "param", "lst"
     
215.     End With
     
216.     GetFirstDerivative = retval
     
217. 
     
218. End Function
     
219. 
     
220. Public Function GetParameterAtDistance(Dist As Double) As Double
     
221. 
     
222.     Dim retval As Double
     
223.    
     
224.     With objVLAX
     
225.         .SetLispSymbol "handle", mvarEntity.Handle
     
226.         .SetLispSymbol "dist", Dist
     
227.         retval = .EvalLispExpression("(vlax-curve-getParamAtDist (handent handle) dist)")
     
228.         .NullifySymbol "handle", "dist"
     
229.     End With
     
230.     GetParameterAtDistance = retval
     
231. 
     
232. End Function
     
233. 
     
234. Public Function GetParameterAtPoint(Point As Variant) As Double
     
235. 
     
236.     Dim retval As Double
     
237.    
     
238.     With objVLAX
     
239.         .SetLispSymbol "handle", mvarEntity.Handle
     
240.         .SetLispSymbol "point", Point
     
241.         retval = .EvalLispExpression("(vlax-curve-getparamAtPoint (handent handle) point)")
     
242.         .NullifySymbol "handle", "point"
     
243.     End With
     
244.     GetParameterAtPoint = retval
     
245. 
     
246. End Function
     
247. 
     
248. Public Function GetPointAtDistance(Dist As Double) As Variant
     
249. 
     
250.     Dim retval As Variant, pt(0 To 2) As Double
     
251.     Dim i As Long
     
252.    
     
253.     With objVLAX
     
254.         .SetLispSymbol "handle", mvarEntity.Handle
     
255.         .SetLispSymbol "dist", Dist
     
256.         .EvalLispExpression "(setq lst (vlax-curve-getPointAtDist (handent handle) dist))"
     
257.         retval = .GetLispList("lst")
     
258.         .NullifySymbol "handle", "dist", "lst"
     
259.     End With
     
260.    
     
261.     For i = 0 To 2
     
262.         pt(i) = retval(i)
     
263.     Next
     
264.    
     
265.     GetPointAtDistance = pt
     
266. 
     
267. End Function
     
268. 
     
269. Public Function GetPointAtParameter(Param As Double) As Variant
     
270. 
     
271.     Dim retval As Variant, pt(0 To 2) As Double
     
272.     Dim i As Long
     
273.    
     
274.     With objVLAX
     
275.         .SetLispSymbol "handle", mvarEntity.Handle
     
276.         .SetLispSymbol "param", Param
     
277.         .EvalLispExpression "(setq lst (vlax-curve-getPointAtParam (handent handle) param))"
     
278.         retval = .GetLispList("lst")
     
279.         .NullifySymbol "handle", "param", "lst"
     
280.     End With
     
281.    
     
282.     For i = 0 To 2
     
283.         pt(i) = retval(i)
     
284.     Next
     
285.    
     
286.     GetPointAtParameter = pt
     
287. 
     
288. End Function
     
289. 
     
290. Public Function GetSecondDerivative(Param As Double) As Variant
     
291. 
     
292.     Dim retval As Variant
     
293.    
     
294.     With objVLAX
     
295.         .SetLispSymbol "handle", mvarEntity.Handle
     
296.         .SetLispSymbol "param", Param
     
297.         .EvalLispExpression "(setq lst (vlax-curve-getSecondDeriv (handent handle) param))"
     
298.         retval = .GetLispList("lst")
     
299.         .NullifySymbol "handle", "param", "lst"
     
300.     End With
     
301.     GetSecondDerivative = retval
     
302. 
     
303. End Function
     
304. 
     
305. Public Property Get length() As Double
     
306. 
     
307.     Dim retval As Double
     
308.    
     
309.     With objVLAX
     
310.         .SetLispSymbol "handle", mvarEntity.Handle
     
311.         .EvalLispExpression "(setq curve (handent handle))"
     
312.         retval = .EvalLispExpression("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))")
     
313.         .NullifySymbol "handle", "curve"
     
314.     End With
     
315.     length = retval
     
316. 
     
317. End Property
     
318. 
     
319. Public Property Get Periodic() As Boolean
     
320. 
     
321.     Dim retval As Boolean
     
322.    
     
323.     With objVLAX
     
324.         .SetLispSymbol "handle", mvarEntity.Handle
     
325.         retval = .EvalLispExpression("(vlax-curve-isPeriodic (handent handle))")
     
326.         .NullifySymbol "handle"
     
327.     End With
     
328.     Periodic = retval
     
329. 
     
330. End Property
     
331. 
     
332. Public Property Get Planar() As Boolean
     
333. 
     
334.     Dim retval As Boolean
     
335.    
     
336.     With objVLAX
     
337.         .SetLispSymbol "handle", mvarEntity.Handle
     
338.         retval = .EvalLispExpression("(vlax-curve-isPlanar (handent handle))")
     
339.         .NullifySymbol "handle"
     
340.     End With
     
341.     Planar = retval
     
342. 
     
343. End Property
     
344. 
     
345. Public Property Get StartPoint() As Variant
     
346. 
     
347.     Dim retval As Variant, pt(0 To 2) As Double
     
348.     dim As Long
     
349.    
     
350.     With objVLAX
     
351.         .SetLispSymbol "handle", mvarEntity.Handle
     
352.         .EvalLispExpression "(setq lst (vlax-curve-getStartPoint (handent handle)))"
     
353.         retval = .GetLispList("lst")
     
354.         .NullifySymbol "handle", "lst"
     
355.     End With
     
356.    
     
357.     For i = 0 To 2
     
358.         pt(i) = retval(i)
     
359.     Next
     
360.    
     
361.     StartPoint = pt
     
362. 
     
363. End Property
     
364. 
     
365. Public Function GetClosestPointToProjection(Point As Variant, Normal As Variant, Optional Extend As Boolean = False) As Variant
     
366. 
     
367.     Dim retval As Variant, pt(0 To 2) As Double
     
368.     Dim i As Long
     
369.    
     
370.     With objVLAX
     
371.         .SetLispSymbol "handle", mvarEntity.Handle
     
372.         .SetLispSymbol "givenPt", Point
     
373.         .SetLispSymbol "normal", Normal
     
374.         If Extend Then .EvalLispExpression "(setq ext T)"
     
375.         .EvalLispExpression "(setq lst (vlax-curve-getClosestPointToProjection (handent handle) givenPt normal ext))"
     
376.         retval = .GetLispList("lst")
     
377.         .NullifySymbol "handle", "lst", "normal", "ext", "givenPt"
     
378.     End With
     
379.    
     
380.     For i = 0 To 2
     
381.         pt(i) = retval(i)
     
382.     Next
     
383.    
     
384.     GetClosestPointToProjection = pt
     
385. 
     
386. End Function
     
387. 
     
388.   [/FONT]
     

<br />   [FONT=courier new]<br /> VERSION 1.0 CLASS<br /> BEGIN<br />   MultiUse = -1  'True<br /> END<br /> Attribute VB_Name = "Curve"<br /> Attribute VB_GlobalNameSpace = False<br /> Attribute VB_Creatable = False<br /> Attribute VB_PredeclaredId = False<br /> Attribute VB_Exposed = False<br /> ' Curve.cls v1.3 (Last updated 12/18/2001)<br /> ' Copyright 2000, 2001 by Frank Oquendo<br /> '<br /> ' Permission to use, copy, modify, and distribute this software<br /> ' for any purpose and without fee is hereby granted, provided<br /> ' that the above copyright notice appears in all copies and<br /> ' that both that copyright notice and the limited warranty and<br /> ' restricted rights notice below appear in all supporting<br /> ' documentation.<br /> '<br /> ' FRANK OQUENDO (THE AUTHOR) PROVIDES THIS PROGRAM "AS IS" AND WITH<br /> ' ALL FAULTS. THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY<br /> ' OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  THE AUTHOR<br /> ' DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE<br /> ' UNINTERRUPTED OR ERROR FREE.<br /> '<br /> ' Use, duplication, or disclosure by the U.S. Government is subject to<br /> ' restrictions set forth in FAR 52.227-19 (Commercial Computer<br /> ' Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)<br /> ' (Rights in Technical Data and Computer Software), as applicable.<br /> '<br /> ' Curve.cls allows developers to access the various VLAX-CURVE functions<br /> ' from Visual Basic or VBA.<br /> '<br /> ' Notes:<br /> ' I do not claim copyright or authorship of the code being wrapped by this module,<br /> ' only on this compilation of that code.<br /> '<br /> ' Dependencies:<br /> ' Use of this class module requires the following files:<br /> ' 1. VLAX.CLS - This file can be obtained by visiting [url]http://www.acadx.com[/url]<br /> <br /> Private objVLAX As VLAX<br /> Private mvarEntity As AcadEntity<br /> Private types(8) As String<br /> <br /> Private Sub Class_Initialize()<br /> <br />     Set objVLAX = New VLAX<br />     types(0) = "AcDbCircle": types(1) = "AcDbLine"<br />     types(2) = "AcDbArc": types(3) = "AcDbSpline"<br />     types(4) = "AcDb3dPolyline": types(5) = "AcDbPolyline"<br />     types(6) = "AcDb2dPolyline": types(7) = "AcDbEllipse"<br />     types(8) = "AcDbLeader"<br /> <br /> End Sub<br /> <br /> Private Sub Class_Terminate()<br /> <br />     Set objVLAX = Nothing<br /> <br /> End Sub<br /> <br /> Public Property Set Entity(ent As AcadEntity)<br /> <br />     Dim tmp As String, i As Long, bFound As Boolean<br />     <br />     tmp = ent.ObjectName<br />     <br />     For i = 0 To 8<br />         If tmp = types(i) Then<br />             Set mvarEntity = ent<br />             bFound = True<br />             Exit For<br />         End If<br />     Next<br />     <br />     If Not bFound Then Err.Raise vbObjectError + 1, , "That entity is not a curve."<br /> <br /> End Property<br /> <br /> Public Property Get Entity() As AcadEntity<br /> <br />     Set entityt = mvarEntity<br /> <br /> End Property<br /> <br /> Public Property Get CurveType() As String<br /> <br />     CurveType = mvarEntity.ObjectName<br /> <br /> End Property<br /> <br /> Public Property Get Area() As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         retval = .EvalLispExpression("(vlax-curve-getArea (handent handle))")<br />         .NullifySymbol "handle"<br />     End With<br />     Area = retval<br /> <br /> End Property<br /> <br /> Public Property Get Closed() As Boolean<br /> <br />     Dim retval As Boolean<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         retval = .EvalLispExpression("(vlax-curve-isClosed (handent handle))")<br />         .NullifySymbol "handle"<br />     End With<br />     Closed = retval<br /> <br /> End Property<br /> <br /> Public Property Get EndParameter() As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         retval = .EvalLispExpression("(vlax-curve-getEndParam (handent handle))")<br />         .NullifySymbol "handle"<br />     End With<br />     EndParameter = retval<br /> <br /> End Property<br /> <br /> Public Property Get EndPoint() As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     Dim i As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .EvalLispExpression "(setq lst (vlax-curve-getEndPoint (handent handle)))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "lst"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     EndPoint = pt<br /> <br /> End Property<br /> <br /> Public Function GetClosestPointTo(Point, Optional Extend As Boolean = False) As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     Dim i As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "givenPt", Point<br />         If Extend Then .EvalLispExpression "(setq ext T)"<br />         .EvalLispExpression "(setq lst (vlax-curve-getClosestPointTo (handent handle) givenPt ext))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "lst", "ext", "givenPt"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     GetClosestPointTo = pt<br /> <br /> End Function<br /> <br /> Public Function GetDistanceAtParameter(Param As Double) As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "param", Param<br />         retval = .EvalLispExpression("(vlax-curve-getDistAtParam (handent handle) param)")<br />         .NullifySymbol "handle", "param"<br />     End With<br />     GetDistanceAtParameter = retval<br /> <br /> End Function<br /> <br /> Public Function GetDistanceAtPoint(Point As Variant) As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "point", Point<br />         retval = .EvalLispExpression("(vlax-curve-getDistAtPoint (handent handle) point)")<br />         .NullifySymbol "handle", "point"<br />     End With<br />     GetDistanceAtPoint = retval<br /> <br /> End Function<br /> <br /> Public Function GetFirstDerivative(Param As Double) As Variant<br /> <br />     Dim retval As Variant<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "param", Param<br />         .EvalLispExpression "(setq lst (vlax-curve-getFirstDeriv (handent handle) param))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "param", "lst"<br />     End With<br />     GetFirstDerivative = retval<br /> <br /> End Function<br /> <br /> Public Function GetParameterAtDistance(Dist As Double) As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "dist", Dist<br />         retval = .EvalLispExpression("(vlax-curve-getParamAtDist (handent handle) dist)")<br />         .NullifySymbol "handle", "dist"<br />     End With<br />     GetParameterAtDistance = retval<br /> <br /> End Function<br /> <br /> Public Function GetParameterAtPoint(Point As Variant) As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "point", Point<br />         retval = .EvalLispExpression("(vlax-curve-getparamAtPoint (handent handle) point)")<br />         .NullifySymbol "handle", "point"<br />     End With<br />     GetParameterAtPoint = retval<br /> <br /> End Function<br /> <br /> Public Function GetPointAtDistance(Dist As Double) As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     Dim i As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "dist", Dist<br />         .EvalLispExpression "(setq lst (vlax-curve-getPointAtDist (handent handle) dist))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "dist", "lst"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     GetPointAtDistance = pt<br /> <br /> End Function<br /> <br /> Public Function GetPointAtParameter(Param As Double) As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     Dim i As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "param", Param<br />         .EvalLispExpression "(setq lst (vlax-curve-getPointAtParam (handent handle) param))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "param", "lst"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     GetPointAtParameter = pt<br /> <br /> End Function<br /> <br /> Public Function GetSecondDerivative(Param As Double) As Variant<br /> <br />     Dim retval As Variant<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "param", Param<br />         .EvalLispExpression "(setq lst (vlax-curve-getSecondDeriv (handent handle) param))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "param", "lst"<br />     End With<br />     GetSecondDerivative = retval<br /> <br /> End Function<br /> <br /> Public Property Get length() As Double<br /> <br />     Dim retval As Double<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .EvalLispExpression "(setq curve (handent handle))"<br />         retval = .EvalLispExpression("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))")<br />         .NullifySymbol "handle", "curve"<br />     End With<br />     length = retval<br /> <br /> End Property<br /> <br /> Public Property Get Periodic() As Boolean<br /> <br />     Dim retval As Boolean<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         retval = .EvalLispExpression("(vlax-curve-isPeriodic (handent handle))")<br />         .NullifySymbol "handle"<br />     End With<br />     Periodic = retval<br /> <br /> End Property<br /> <br /> Public Property Get Planar() As Boolean<br /> <br />     Dim retval As Boolean<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         retval = .EvalLispExpression("(vlax-curve-isPlanar (handent handle))")<br />         .NullifySymbol "handle"<br />     End With<br />     Planar = retval<br /> <br /> End Property<br /> <br /> Public Property Get StartPoint() As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     dim As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .EvalLispExpression "(setq lst (vlax-curve-getStartPoint (handent handle)))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "lst"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     StartPoint = pt<br /> <br /> End Property<br /> <br /> Public Function GetClosestPointToProjection(Point As Variant, Normal As Variant, Optional Extend As Boolean = False) As Variant<br /> <br />     Dim retval As Variant, pt(0 To 2) As Double<br />     Dim i As Long<br />     <br />     With objVLAX<br />         .SetLispSymbol "handle", mvarEntity.Handle<br />         .SetLispSymbol "givenPt", Point<br />         .SetLispSymbol "normal", Normal<br />         If Extend Then .EvalLispExpression "(setq ext T)"<br />         .EvalLispExpression "(setq lst (vlax-curve-getClosestPointToProjection (handent handle) givenPt normal ext))"<br />         retval = .GetLispList("lst")<br />         .NullifySymbol "handle", "lst", "normal", "ext", "givenPt"<br />     End With<br />     <br />     For i = 0 To 2<br />         pt(i) = retval(i)<br />     Next<br />     <br />     GetClosestPointToProjection = pt<br /> <br /> End Function<br /> <br />   [/FONT]<br />

efan2000

这个附件是用于vb.net的vlax类库，有兴趣的朋友可以研究一下。

bravechen

think you

wwwdong

如：
DIM OBJ AS VLAX
SET OBJ =NEW VLAX
在上一行时出错，何故？
另，
上述程序行
Attribute VB_Name = "VLAX"
VB并不支持

fylinwater

终于找到lisp和vba的交流方式了
SetLispSymbol( symbolName, value)
GetLispSymbol(symbolName)
还是容易出错，主要是lisp变量类型会变化，感觉要做个完美的GetLispSymbol比较困难

darkblue

好东东，可惜我还不能下载。

lishujun_hb007

我很喜欢这个接口，万分感谢

topirol

好像兼容性不是很好，使用过程有不稳定的现象

god

好，有没有更详细的说明，acad帮助中有这个吗？

雪山飞狐(lzh)

VB.Net不需vlax类库，vlax类是弥补VBA的缺陷的，可以看Lisp的帮助

ironwill2004

最初由 efan2000 发布
[B]下面的类库扩充了VBA处理曲线类对象的能力。
[CODE]
  
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Curve"
Attribute VB_GlobalNameSpace = False
Attri... [/B]

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VLAX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
我搞不清这些东西是什么？所以我把他们注释掉了，可以使用，为什么？？

fylinwater

很多机器上只有按照2002 vlax类不存在，怎么注册？

舟自横

好象看来不错,下拉!

yj821005

我的CAD2002，vlax类不存在，怎么注册？ 哪里有下，谢谢！！