Swamp,
I found a few references to acedGetSym and acedPutSym on the swamp.
I am studying these functions, I have re-written them.
I would appreciate your comments.
I use the LISPFunction to test them.
Peter
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports System.Runtime.InteropServices 'for DllImport()
Imports System.Security
Public Class vbvlClass
' Use P/Invoke for acedGetSym
<DllImport("acad.exe", CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Cdecl, EntryPoint:="acedGetSym")> _
Private Shared Function acedGetSymbol(ByVal strSymbolName As String, <Out()> ByRef intHandle As IntPtr) As Integer
End Function
' Use P/Invoke for acedPutSym
<DllImport("acad.exe", CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Cdecl, EntryPoint:="acedPutSym")> _
Private Shared Function acedPutSymbol(ByVal strSymbolName As String, ByVal intHandle As IntPtr) As Integer
End Function
'______________________________________________________________________________________________________________________
'
' Get and Set lisp symbol values using th P/Evoke
'______________________________________________________________________________________________________________________
<LispFunction("GetLISPSymbol")> _
Public Shared Function GetLISPSymbol(ByVal rbfLISPSymbolName As ResultBuffer) As ResultBuffer
Dim intStatus As Integer
Dim rbfObject As IntPtr = IntPtr.Zero
Dim rbfReturn As New ResultBuffer
Dim strLISPSymbolName As String = rbfLISPSymbolName.AsArray(0).Value.ToString
Try
intStatus = acedGetSymbol(strLISPSymbolName, rbfObject)
If intStatus = CType(PromptStatus.OK, Integer) AndAlso Not (rbfObject = IntPtr.Zero) Then
rbfReturn = CType(DisposableWrapper.Create(GetType(ResultBuffer), rbfObject, True), ResultBuffer)
End If
If rbfReturn.AsArray.Length = 0 Then
rbfReturn.Add(New TypedValue(&H138D, "nil"))
End If
Catch Ex As Exception
rbfReturn.Add(New TypedValue(&H138D, "Error " & Ex.Message))
End Try
Return rbfReturn
End Function
'______________________________________________________________________________________________________________________
'
' Overload GetLISPSymbol function to accept a string and return a result buffer
'______________________________________________________________________________________________________________________
Public Shared Function GetLISPSymbol(ByVal strLISPSymbolName As String) As ResultBuffer
Dim intStatus As Integer
Dim rbfObject As IntPtr = IntPtr.Zero
Dim rbfReturn As New ResultBuffer
Try
intStatus = acedGetSymbol(strLISPSymbolName, rbfObject)
If intStatus = CType(PromptStatus.OK, Integer) AndAlso Not (rbfObject = IntPtr.Zero) Then
rbfReturn = CType(DisposableWrapper.Create(GetType(ResultBuffer), rbfObject, True), ResultBuffer)
End If
If rbfReturn.AsArray.Length = 0 Then
rbfReturn.Add(New TypedValue(&H138D, "nil"))
End If
Catch Ex As Exception
rbfReturn.Add(New TypedValue(&H138D, "Error " & Ex.Message))
End Try
Return rbfReturn
End Function
'______________________________________________________________________________________________________________________
'
' PutLISPSymbol function to accept and return result buffers
'______________________________________________________________________________________________________________________
<LispFunction("PutLISPSymbol")> _
Public Function PutSymbol(ByVal rbfLispArguments As ResultBuffer) As ResultBuffer
Dim intStatus As Integer = 0
Dim rbfReturn As New ResultBuffer
Dim arrLISPArguments As TypedValue() = rbfLispArguments.AsArray()
Dim rbfSymbol As ResultBuffer = New ResultBuffer
Dim strResult As String = ""
Try
For intItem = 1 To arrLISPArguments.Length - 1
rbfSymbol.Add(arrLISPArguments(intItem))
MsgBox(arrLISPArguments(intItem).ToString)
Next intItem
intStatus = acedPutSymbol(arrLISPArguments(0).Value.ToString, rbfSymbol.UnmanagedObject)
rbfReturn.Add(New TypedValue(&H138D, "Success "))
Catch Ex As Exception
rbfReturn.Add(New TypedValue(&H138D, "Error " & Ex.Message))
End Try
rbfLispArguments.Dispose()
rbfSymbol.Dispose()
Return rbfReturn
End Function
End Class
