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