Written by Tony Tanzillo sometime in the beginning of the 21st Century . . .
Private vlapp As Object
Private vlFuncs As Object
Public Function EvalLispExpression(lispStatement As String)
Dim sym As Object, RET As Object, retVal
Set vlapp = CreateObject("Vl.Application.16")
Set vlFuncs = vlapp.ActiveDocument.Functions
Set sym = vlFuncs.Item("read").funcall(lispStatement)
On Error Resume Next
retVal = vlFuncs.Item("eval").funcall(sym)
If Err Then
EvalLispExpression = ""
Else
EvalLispExpression = retVal
End If
End Function
Public Sub SetLispVar(Symbol As String, Value)
'Dim vlapp As Object
'Dim vlFuncs As Object
Dim vlSet As Object
Dim vSym
Set vlapp = CreateObject("Vl.Application.16")
Set vlFuncs = vlapp.ActiveDocument.Functions
Set vSym = vlFuncs.Item("read").funcall(Symbol)
Set vlSet = vlFuncs.Item("set")
Select Case VarType(Value)
Case vbByte, vbInteger, vbLong
Dim lVal As Long
lVal = Value
vlSet.funcall vSym, lVal
Case vbString
Dim strVal As String
strVal = Value
vlSet.funcall vSym, strVal
Case vbDouble
Dim dblVal As String
dblVal = Value
vlSet.funcall vSym, dblVal
Case vbEmpty
vlSet.funcall vSym, vlFuncs.Item("read").funcall("nil")
Case Else
If IsArray(Value) Then
Dim List As Variant
List = Value
vlSet.funcall vSym, List
Else
vlSet.funcall vSym, Value
End If
End Select
End Sub
Public Function GetLispVar(Symbol As String) As Variant
'Dim vlapp As Object
'Dim vlFuncs As Object
Set vlapp = CreateObject("Vl.Application.16")
Set vlFuncs = vlapp.ActiveDocument.Functions
GetLispVar = vlFuncs.Item("eval").funcall(vlFuncs.Item("read").funcall(Symbol))
End Function
Here are some example uses:
If index1 > -1 Then
ws = ListBox1.List(ListBox1.ListIndex)
End If
If index2 > -1 Then
dwg = ListBox2.List(ListBox2.ListIndex)
End If
SetLispVar "jb%WorkingState", ws
SetLispVar "jb%WSXref", dwg