Community
.NET
cancel
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Trying to translate Ockendo's VLAX class under VB.NET

17 REPLIES 17
Back to AutoCAD Customization Category
Back to Topic Listing
Reply
Message 1 of 18
Anonymous
1524 Views, 17 Replies
‎02-08-2010 10:32 AM
‎02-08-2010 10:32 AM

Trying to translate Ockendo's VLAX class under VB.NET

Hello,
I'm trying to translate the old but usefull VLAX class for VB.NET.
The VLAX class is usefull to use lisp code with VBA.
so as well as VB.Net allow the use of .Net commands under lisp,
making lisp command callable by .NET is very interresting.

In the begenning, i've tryed to convert VLAX original using interrop.
Without any success.

Then i've found a japanese version, but unfortunaly wrote with c# :
http://www1.harenet.ne.jp/~hanafusa/mt/memo/archives/000236.html

Here my project, with 2 ways of exploration :

http://www.g-eaux.com/pages_perso/VLAX.zip

any help appreciated, as i know i will never succeed alone.

Thanks,

Gérald
Report
0 Likes
Reply
17 REPLIES 17
Message 2 of 18
Hallex
Advisor
in reply to: Anonymous
‎02-08-2010 11:43 AM
‎02-08-2010 11:43 AM

Converted with help of:
http://converter.telerik.com/
{code}
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports AcRx = Autodesk.AutoCAD.Runtime
Imports AcEd = Autodesk.AutoCAD.ApplicationServices
Imports AcGe = Autodesk.AutoCAD.Geometry
Imports AcDb = Autodesk.AutoCAD.DatabaseServices
#End Region

Namespace HLIB.Utils
'''
''' VisualLISPと通信。
''' (vl-load-com)を実行してないとだめ。
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication

'''
''' コンストラクタ
'''
''' AutoCADアプリケーション
Public Sub New(acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
AcEd.CommandLinePrompts.Message(vbLf & "VLオブジェクトの取得に失敗しました.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp によって使用されているリソースを開放します。
'''
Public Sub Dispose()
If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True
End If
End Sub

'''
''' COMオブジェクトからプロパティを取得します。
'''
''' 取得元のオブジェクト
''' プロパティ名
'''
Private Function GetProperty(obj As Object, propName As String) As Object
Return obj.[GetType]().InvokeMember(propName, BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COMオブジェクトからインデクサを取得します。
'''
''' 取得もとのオブジェクト
''' インデックス名
'''
Private Function GetIndexer(obj As Object, index As String) As Object
Return obj.[GetType]().InvokeMember("Item", BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP関数を呼び出し、結果を返します。
'''
''' LISP関数名
''' 引数
'''
Private Function InvokeLispFunction(funcName As String, args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall", BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP式を評価します。
'''
''' LISP式
'''
Public Function Eval(lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
AcEd.CommandLinePrompts.Message(vbLf & "LISP式の評価に失敗しました.")
Return Nothing
End Try
End Function

'''
''' LISP変数から値を取得します。
'''
''' 変数名
'''
Public Function GetValue(symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP変数に値を代入します。
'''
''' 変数名
''' 値
Public Sub SetValue(symbolName As String, val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val + "))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP変数にnilを代入します
'''
''' 変数名
Public Sub SetSymbolsToNil(ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
End Sub

'''
''' LISTをArrayListに変換します。
'''
''' LISTの入った変数名
'''
Public Function GetLispList(symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i, list}))
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXFコードから情報を取得します。
'''
''' DXFコード
''' 図形名
'''
Private Function getDxfData(code As Integer, symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object() {code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIPの選択セットをAcadEntityの配列に変換します。
'''
''' 選択セットの入っている変数名
''' AcadEntity配列の入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long = DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New Object() {ss, i})
ents(i) = DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5, en), String))), AcadEntity)
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIPの選択セットをActiveXの選択セットに変換します。
'''
''' 選択セットの入っている変数名
''' AcadSelectionSetの入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function

'''
''' LSIPの選択セットをObjectIdCollectionに変換します。
'''
''' 選択セットの入っている変数名
''' ObjectIdCollectionの入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef objIds As AcDb.ObjectIdCollection) As Boolean
Dim ret As Boolean = False
objIds.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
For Each en As AcadEntity In ents
Dim id As New AcDb.ObjectId()
id.OldId = en.ObjectID
objIds.Add(id)
Next
ret = True
End If
Return ret
End Function

'''
''' ObjectIdCollectionをLISPの選択セットに変換します。
'''
''' ObjectIdCollection
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(objIds As AcDb.ObjectIdCollection, symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each id As AcDb.ObjectId In objIds
Eval("(ssadd (handent """ + id.Handle + """)" + symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function

'''
''' AcadSelectionSetをLISPの選択セットに変換します。
'''
''' AcadSelectionSet
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(acadSS As AcadSelectionSet, symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" + symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace

'=======================================================
'Service provided by Telerik (www.telerik.com)
'Conversion powered by NRefactory.
'Built and maintained by Todd Anglin and Telerik
'=======================================================

{code}

~'J'~
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Report
0 Likes
Reply
Message 3 of 18
Anonymous
in reply to: Anonymous
‎02-09-2010 01:44 AM
‎02-09-2010 01:44 AM

hallex a écrit :
> Converted with help of: http://converter.telerik.com/
Thanks,
i've tryed also that translation, but it still not work.
her my adaptation, that loads, but make an error :

'#region Using directives

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports Autodesk.AutoCAD.Runtime 'AcRx
Imports Aced = Autodesk.AutoCAD.ApplicationServices 'AcEd
Imports Autodesk.AutoCAD.Geometry 'AcGe
Imports Autodesk.AutoCAD.DatabaseServices 'AcDb
Imports Autodesk.AutoCAD.ApplicationServices.Application ' AcadApp

'#End Region

Namespace HLIB.Ut
'''
''' VisualLISPと通信。
''' (vl-load-com)を実行してないとだめ。
'''
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication



'''
''' コンストラクタ
'''
''' AutoCADアプリケーション
Public Sub New(ByVal acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
acadApp.CommandLinePrompts.Message(vbLf & "VLオブジェク
トの取得に失敗しました.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp によって使用されているリソースを開放します。
'''
Public Sub Dispose() Implements IDisposable.Dispose

If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True

End If
End Sub

'''
''' COMオブジェクトからプロパティを取得します。
'''
''' 取得元のオブジェクト
''' プロパティ名
'''
Private Function GetProperty(ByVal obj As Object, ByVal propName
As String) As Object
Return obj.[GetType]().InvokeMember(propName,
BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COMオブジェクトからインデクサを取得します。
'''
''' 取得もとのオブジェクト
''' インデックス名
'''
Private Function GetIndexer(ByVal obj As Object, ByVal index As
String) As Object
Return obj.[GetType]().InvokeMember("Item",
BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP関数を呼び出し、結果を返します。
'''
''' LISP関数名
''' 引数
'''
Private Function InvokeLispFunction(ByVal funcName As String,
ByVal args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall",
BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP式を評価します。
'''
''' LISP式
'''
_
Public Function Eval(ByVal lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New
Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
acadApp.CommandLinePrompts.Message(vbLf & "LISP式の評価
に失敗しました.")
Return Nothing
End Try
End Function

'''
''' LISP変数から値を取得します。
'''
''' 変数名
'''
Public Function GetValue(ByVal symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP変数に値を代入します。
'''
''' 変数名
''' 値
Public Sub SetValue(ByVal symbolName As String, ByVal val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val +
"))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP変数にnilを代入します
'''
''' 変数名
_
Public Sub SetSymbolsToNil(ByVal ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
End Sub

'''
''' LISTをArrayListに変換します。
'''
''' LISTの入った変数名
'''
Public Function GetLispList(ByVal symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New
Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i,
list}))

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXFコードから情報を取得します。
'''
''' DXFコード
''' 図形名
'''
Private Function getDxfData(ByVal code As Integer, ByVal
symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New
Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object()
{code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIPの選択セットをAcadEntityの配列に変換します。
'''
''' 選択セットの入っている変数名
''' AcadEntity配列の入れ物
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long =
DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New
Object() {ss, i})
ents(i) =
DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5,
en), String))), AcadEntity)

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIPの選択セットをActiveXの選択セットに変換します。
'''
''' 選択セットの入っている変数名
''' AcadSelectionSetの入れ物
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function


'''
''' AcadSelectionSetをLISPの選択セットに変換します。
'''
''' AcadSelectionSet
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(ByVal acadSS As
AcadSelectionSet, ByVal symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" +
symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace
Report
0 Likes
Reply
Message 4 of 18
Anonymous
in reply to: Anonymous
‎02-09-2010 07:50 AM
‎02-09-2010 07:50 AM

I don't understand why someone would want to use this
to call LISP from VB.NET, when VB.NET and the managed
ObjectARX API gives them everything that LISP has, and
much, much more.

If you have existing VBA code that calls LISP, then my
advice is to start learning the managed ObjectARX API
and as soon as you can, migrate your code to use that,
rather than rely on LISP.

--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD
Supporting AutoCAD 2000 through 2010

http://www.acadxtabs.com

Email: string.Format("{0}@{1}.com", "tonyt", "caddzone");

"gégématic <-remove-it-gegematic@g-eaux.com>"
<=?UTF-8?Q?g=C3=A9g=C3=A9matic_<-remove-it-gegematic@g-eaux.com>?=> wrote in
message news:6332791@discussion.autodesk.com...
hallex a écrit :
> Converted with help of: http://converter.telerik.com/
Thanks,
i've tryed also that translation, but it still not work.
her my adaptation, that loads, but make an error :

'#region Using directives

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports Autodesk.AutoCAD.Runtime 'AcRx
Imports Aced = Autodesk.AutoCAD.ApplicationServices 'AcEd
Imports Autodesk.AutoCAD.Geometry 'AcGe
Imports Autodesk.AutoCAD.DatabaseServices 'AcDb
Imports Autodesk.AutoCAD.ApplicationServices.Application ' AcadApp

'#End Region

Namespace HLIB.Ut
'''
''' VisualLISP????
''' (vl-load-com)???????????
'''
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication



'''
''' ???????
'''
''' AutoCAD????????
Public Sub New(ByVal acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
acadApp.CommandLinePrompts.Message(vbLf & "VL?????
???????????.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp ??????????????????????
'''
Public Sub Dispose() Implements IDisposable.Dispose

If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True

End If
End Sub

'''
''' COM????????????????????
'''
''' ??????????
''' ??????
'''
Private Function GetProperty(ByVal obj As Object, ByVal propName
As String) As Object
Return obj.[GetType]().InvokeMember(propName,
BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COM????????????????????
'''
''' ???????????
''' ???????
'''
Private Function GetIndexer(ByVal obj As Object, ByVal index As
String) As Object
Return obj.[GetType]().InvokeMember("Item",
BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP????????????????
'''
''' LISP???
''' ??
'''
Private Function InvokeLispFunction(ByVal funcName As String,
ByVal args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall",
BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP????????
'''
''' LISP?
'''
_
Public Function Eval(ByVal lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New
Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
acadApp.CommandLinePrompts.Message(vbLf & "LISP????
???????.")
Return Nothing
End Try
End Function

'''
''' LISP????????????
'''
''' ???
'''
Public Function GetValue(ByVal symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP???????????
'''
''' ???
''' ?
Public Sub SetValue(ByVal symbolName As String, ByVal val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val +
"))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP???nil??????
'''
''' ???
_
Public Sub SetSymbolsToNil(ByVal ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
End Sub

'''
''' LIST?ArrayList???????
'''
''' LIST???????
'''
Public Function GetLispList(ByVal symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New
Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i,
list}))

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXF??????????????
'''
''' DXF???
''' ???
'''
Private Function getDxfData(ByVal code As Integer, ByVal
symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New
Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object()
{code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIP???????AcadEntity??????????
'''
''' ??????????????
''' AcadEntity??????
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long =
DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New
Object() {ss, i})
ents(i) =
DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5,
en), String))), AcadEntity)

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIP???????ActiveX?????????????
'''
''' ??????????????
''' AcadSelectionSet????
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function


'''
''' AcadSelectionSet?LISP?????????????
'''
''' AcadSelectionSet
''' ????????????
'''
Public Function SelectionSetToPickSet(ByVal acadSS As
AcadSelectionSet, ByVal symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" +
symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace
Report
0 Likes
Reply
Message 5 of 18
Anonymous
in reply to: Anonymous
‎02-09-2010 08:26 AM
‎02-09-2010 08:26 AM

Tony Tanzillo a écrit :
> I don't understand why someone would want to use this
> to call LISP from VB.NET, when VB.NET and the managed
> ObjectARX API gives them everything that LISP has, and
> much, much more.
>
> If you have existing VBA code that calls LISP, then my
> advice is to start learning the managed ObjectARX API
> and as soon as you can, migrate your code to use that,
> rather than rely on LISP.
>
Hello Tony,
and thanks for your so many years help ! (i must have read your
publications since 1997...)

In the past, i've tryed to learn VBA.
even if i succeded in building few functions, i've never feel as easy
with vba than with lisp.
much of my code is single use : I've a problem for processing many
entity, drawing, i must program to do the stuff, and that's all.
Lisp is very interresting for that kind of approach : my programs are
scratch
i don't spend much of my time programming, i do much drawing or land
survey, so i prefer very simples languages.
In the past have used VBA for the lacks of lisp : forms, somes events,
file handling ...
Now i need to do the same with .net, but my developpement will be faster
if i can re-use my lisp routine in VB.net,
especially when using .Net to make forms interface.

VLAX.cls was very usefull for me, so if i can go on like that, it's better.
But i've also tryed to generate assembly from the C# source, i've the
same problem.
that kind of program is to complicated for my poor knowledge.

Gérald
Report
0 Likes
Reply
Message 6 of 18
NathTay
Advocate
in reply to: Anonymous
‎02-09-2010 02:08 PM
‎02-09-2010 02:08 PM

Before VBA was introduced into AutoCAD I used to use DCL to create simple dialogs for my LISP routines. When VBA was introduced I moved completely away from LISP. If I still wanted to code in LISP I would look at http://www.objectdcl.com or http://opendcl.com.
Report
0 Likes
Reply
Message 7 of 18
Anonymous
in reply to: Anonymous
‎02-09-2010 11:53 PM
‎02-09-2010 11:53 PM

NathTay a écrit :
> Before VBA was introduced into AutoCAD I used to use DCL to create simple dialogs for my LISP routines. When VBA was introduced I moved completely away from LISP. If I still wanted to code in LISP I would look at http://www.objectdcl.com or http://opendcl.com.
>
Hi,
i experienced some problems of stability with Odcl in the past,
and i dislike to use thirdparty arx in my projects, because i've seen
many arx based project left,
(like doslib) and you can't make work your application when Autodesk
change his version.
definitly, for me, the good solution is something like VLAX class.
I don't know what is wrong, but i think i 'll find the way to make it
work ...
Thanks for your suggestion,
Gégé
Report
0 Likes
Reply
Message 8 of 18
Anonymous
in reply to: Anonymous
‎02-11-2010 02:33 AM
‎02-11-2010 02:33 AM

Tony Tanzillo a écrit :
> I don't understand why someone would want to use this
> to call LISP from VB.NET, when VB.NET and the managed
> ObjectARX API gives them everything that LISP has, and
> much, much more.
>
> If you have existing VBA code that calls LISP, then my
> advice is to start learning the managed ObjectARX API
> and as soon as you can, migrate your code to use that,
> rather than rely on LISP.
>
>
I 've found an other way, and it funny that it was your solution ...

http://discussion.autodesk.com/forums/thread.jspa?threadID=522825&tstart=2475

It works fine, but it generate an error that display a message box :

************** Texte de l'exception **************
System.EntryPointNotFoundException: Impossible de trouver le point
d'entrée '?acedEvaluateLisp@@YAHPB_WAAPAUresbuf@@@Z' dans la DLL 'acad.exe'.
à Rivilis.CSharpToLisp.acedEvaluateLisp(String lispLine, IntPtr& result)
à Rivilis.CSharpToLisp.AcadEvalLisp(String arg) dans
C:\Users\Gerald\Documents\Visual Studio
2008\Projects\VLAX-C\VLAX-C\CodeFile2.cs:ligne 52
à Rivilis.CSharpToLisp.test() dans C:\Users\Gerald\Documents\Visual
Studio 2008\Projects\VLAX-C\VLAX-C\CodeFile2.cs:ligne 94
à Autodesk.AutoCAD.Runtime.CommandClass.InvokeWorker(MethodInfo mi,
Object commandObject, Boolean bLispFunction)
à
Autodesk.AutoCAD.Runtime.CommandClass.InvokeWorkerWithExceptionFilter(MethodInfo
mi, Object commandObject, Boolean bLispFunction)
à Autodesk.AutoCAD.Runtime.CommandClass.CommandThunk.Invoke()


Any ideas ?
Report
0 Likes
Reply
Message 9 of 18
Anonymous
in reply to: Anonymous
‎02-12-2010 03:10 AM
‎02-12-2010 03:10 AM

With the help of Alexander Rivilis, and french programmer Gile,
here a version that work fine, with A64 or 32 :

Even if it seems that the result of a lisp routine cannot be passed to
.net if its a string, or a list.
but .Net let a list or a string assigned to a lisp var, and is able to
read a lisp var containning a string or a list.
So, for the use i've (create forms interface for lisp), it's enough.




//

// Only for AutoCAD 2007+

// This class is using undocumented function acedEvaluateLisp

//

using System;

using Autodesk.AutoCAD.ApplicationServices;

using Autodesk.AutoCAD.DatabaseServices;

using Autodesk.AutoCAD.Runtime;

using Autodesk.AutoCAD.EditorInput;

using System.Runtime.InteropServices;

using AcadApp = Autodesk.AutoCAD.ApplicationServices.Application;



[assembly: CommandClass(typeof(Rivilis.CSharpToLisp))]



namespace Rivilis
{

public class CSharpToLisp
{

[System.Security.SuppressUnmanagedCodeSecurity]

[DllImport("acad.exe", CharSet = CharSet.Unicode,
CallingConvention = CallingConvention.Cdecl,

///Adesk::IntPtr ptr;
///int ptrSize = sizeof( ptr );
///If ptrSize is 4, then you're in a 32-bit module - if
ptrSize is 8, you're in a 64-bit module.

//pour autocad 32 bits
//EntryPoint = "?acedEvaluateLisp@@YAHPB_WAAPAUresbuf@@@Z")]
//pour autocad 64
EntryPoint = "?acedEvaluateLisp@@YAHPEB_WAEAPEAUresbuf@@@Z")]

extern private static int acedEvaluateLisp(string lispLine, out
IntPtr result);



static public ResultBuffer AcadEvalLisp(string arg)
{

IntPtr rb = IntPtr.Zero;

acedEvaluateLisp(arg, out rb);

if (rb != IntPtr.Zero)
{

try
{

ResultBuffer rbb =
DisposableWrapper.Create(typeof(ResultBuffer), rb, true) as ResultBuffer;

return rbb;

}

catch
{

return null;

}

}

return null;

}



static void PrintResbuf(ResultBuffer rb)

{

string s = "\n-----------------------------";

foreach (TypedValue val in rb)

{

if (val.TypeCode == (short)LispDataType.Nil)

s += string.Format("\n{0} -> nil",
(LispDataType)val.TypeCode);

else

s += string.Format("\n{0} -> {1}",
(LispDataType)val.TypeCode,

val.Value.ToString());

s += "\n-----------------------------";

}


AcadApp.DocumentManager.MdiActiveDocument.Editor.WriteMessage(s);

}



// Define Command "CSharpToLisp"

// Only for testing we can define this function.

//

// Example:

// Command: CSharpToLisp

// Enter lisp expression: (+ 100 50 30 20 10)

// -----------------------------

// 5003 -> 210

// -----------------------------

[CommandMethod("CSharpToLisp")]

static public void test()

{

PromptResult rs =


AcadApp.DocumentManager.MdiActiveDocument.Editor.GetString("\nEnter lisp
expression: ");

if (rs.Status == PromptStatus.OK && rs.StringResult != "")

{

ResultBuffer rb = AcadEvalLisp(rs.StringResult);

if (rb != null)

{

PrintResbuf(rb);

}

else

{


AcadApp.DocumentManager.MdiActiveDocument.Editor.WriteMessage("\nError
in evaluation");

}

}

}

}

}
Report
0 Likes
Reply
Message 10 of 18
Anonymous
in reply to: Anonymous
‎02-17-2010 03:56 AM
‎02-17-2010 03:56 AM

NathTay a écrit :
> Before VBA was introduced into AutoCAD I used to use DCL to create simple dialogs for my LISP routines. When VBA was introduced I moved completely away from LISP. If I still wanted to code in LISP I would look at http://www.objectdcl.com or http://opendcl.com.
>
Hi,
i experienced some problems of stability with Odcl in the past,
and i dislike to use thirdparty arx in my projects, because i've seen
many arx based project left,
(like doslib) and you can't make work your application when Autodesk
change his version.
definitly, for me, the good solution is something like VLAX class.
I don't know what is wrong, but i think i 'll find the way to make it
work ...
Thanks for your suggestion,
Gégé
Report
0 Likes
Reply
Message 11 of 18
Anonymous
in reply to: Anonymous
‎02-17-2010 03:56 AM
‎02-17-2010 03:56 AM

Tony Tanzillo a écrit :
> I don't understand why someone would want to use this
> to call LISP from VB.NET, when VB.NET and the managed
> ObjectARX API gives them everything that LISP has, and
> much, much more.
>
> If you have existing VBA code that calls LISP, then my
> advice is to start learning the managed ObjectARX API
> and as soon as you can, migrate your code to use that,
> rather than rely on LISP.
>
Hello Tony,
and thanks for your so many years help ! (i must have read your
publications since 1997...)

In the past, i've tryed to learn VBA.
even if i succeded in building few functions, i've never feel as easy
with vba than with lisp.
much of my code is single use : I've a problem for processing many
entity, drawing, i must program to do the stuff, and that's all.
Lisp is very interresting for that kind of approach : my programs are
scratch
i don't spend much of my time programming, i do much drawing or land
survey, so i prefer very simples languages.
In the past have used VBA for the lacks of lisp : forms, somes events,
file handling ...
Now i need to do the same with .net, but my developpement will be faster
if i can re-use my lisp routine in VB.net,
especially when using .Net to make forms interface.

VLAX.cls was very usefull for me, so if i can go on like that, it's better.
But i've also tryed to generate assembly from the C# source, i've the
same problem.
that kind of program is to complicated for my poor knowledge.

Gérald
Report
0 Likes
Reply
Message 12 of 18
Anonymous
in reply to: Anonymous
‎02-17-2010 03:56 AM
‎02-17-2010 03:56 AM

I don't understand why someone would want to use this
to call LISP from VB.NET, when VB.NET and the managed
ObjectARX API gives them everything that LISP has, and
much, much more.

If you have existing VBA code that calls LISP, then my
advice is to start learning the managed ObjectARX API
and as soon as you can, migrate your code to use that,
rather than rely on LISP.

--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD
Supporting AutoCAD 2000 through 2010

http://www.acadxtabs.com

Email: string.Format("{0}@{1}.com", "tonyt", "caddzone");

"gégématic <-remove-it-gegematic@g-eaux.com>"
<=?UTF-8?Q?g=C3=A9g=C3=A9matic_<-remove-it-gegematic@g-eaux.com>?=> wrote in
message news:6332791@discussion.autodesk.com...
hallex a écrit :
> Converted with help of: http://converter.telerik.com/
Thanks,
i've tryed also that translation, but it still not work.
her my adaptation, that loads, but make an error :

'#region Using directives

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports Autodesk.AutoCAD.Runtime 'AcRx
Imports Aced = Autodesk.AutoCAD.ApplicationServices 'AcEd
Imports Autodesk.AutoCAD.Geometry 'AcGe
Imports Autodesk.AutoCAD.DatabaseServices 'AcDb
Imports Autodesk.AutoCAD.ApplicationServices.Application ' AcadApp

'#End Region

Namespace HLIB.Ut
'''
''' VisualLISP????
''' (vl-load-com)???????????
'''
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication



'''
''' ???????
'''
''' AutoCAD????????
Public Sub New(ByVal acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
acadApp.CommandLinePrompts.Message(vbLf & "VL?????
???????????.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp ??????????????????????
'''
Public Sub Dispose() Implements IDisposable.Dispose

If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True

End If
End Sub

'''
''' COM????????????????????
'''
''' ??????????
''' ??????
'''
Private Function GetProperty(ByVal obj As Object, ByVal propName
As String) As Object
Return obj.[GetType]().InvokeMember(propName,
BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COM????????????????????
'''
''' ???????????
''' ???????
'''
Private Function GetIndexer(ByVal obj As Object, ByVal index As
String) As Object
Return obj.[GetType]().InvokeMember("Item",
BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP????????????????
'''
''' LISP???
''' ??
'''
Private Function InvokeLispFunction(ByVal funcName As String,
ByVal args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall",
BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP????????
'''
''' LISP?
'''
_
Public Function Eval(ByVal lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New
Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
acadApp.CommandLinePrompts.Message(vbLf & "LISP????
???????.")
Return Nothing
End Try
End Function

'''
''' LISP????????????
'''
''' ???
'''
Public Function GetValue(ByVal symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP???????????
'''
''' ???
''' ?
Public Sub SetValue(ByVal symbolName As String, ByVal val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val +
"))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP???nil??????
'''
''' ???
_
Public Sub SetSymbolsToNil(ByVal ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
End Sub

'''
''' LIST?ArrayList???????
'''
''' LIST???????
'''
Public Function GetLispList(ByVal symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New
Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i,
list}))

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXF??????????????
'''
''' DXF???
''' ???
'''
Private Function getDxfData(ByVal code As Integer, ByVal
symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New
Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object()
{code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIP???????AcadEntity??????????
'''
''' ??????????????
''' AcadEntity??????
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long =
DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New
Object() {ss, i})
ents(i) =
DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5,
en), String))), AcadEntity)

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIP???????ActiveX?????????????
'''
''' ??????????????
''' AcadSelectionSet????
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function


'''
''' AcadSelectionSet?LISP?????????????
'''
''' AcadSelectionSet
''' ????????????
'''
Public Function SelectionSetToPickSet(ByVal acadSS As
AcadSelectionSet, ByVal symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" +
symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace
Report
0 Likes
Reply
Message 13 of 18
Anonymous
in reply to: Anonymous
‎02-17-2010 03:56 AM
‎02-17-2010 03:56 AM

hallex a écrit :
> Converted with help of: http://converter.telerik.com/
Thanks,
i've tryed also that translation, but it still not work.
her my adaptation, that loads, but make an error :

'#region Using directives

Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports Autodesk.AutoCAD.Runtime 'AcRx
Imports Aced = Autodesk.AutoCAD.ApplicationServices 'AcEd
Imports Autodesk.AutoCAD.Geometry 'AcGe
Imports Autodesk.AutoCAD.DatabaseServices 'AcDb
Imports Autodesk.AutoCAD.ApplicationServices.Application ' AcadApp

'#End Region

Namespace HLIB.Ut
'''
''' VisualLISPと通信。
''' (vl-load-com)を実行してないとだめ。
'''
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication



'''
''' コンストラクタ
'''
''' AutoCADアプリケーション
Public Sub New(ByVal acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
acadApp.CommandLinePrompts.Message(vbLf & "VLオブジェク
トの取得に失敗しました.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp によって使用されているリソースを開放します。
'''
Public Sub Dispose() Implements IDisposable.Dispose

If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True

End If
End Sub

'''
''' COMオブジェクトからプロパティを取得します。
'''
''' 取得元のオブジェクト
''' プロパティ名
'''
Private Function GetProperty(ByVal obj As Object, ByVal propName
As String) As Object
Return obj.[GetType]().InvokeMember(propName,
BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COMオブジェクトからインデクサを取得します。
'''
''' 取得もとのオブジェクト
''' インデックス名
'''
Private Function GetIndexer(ByVal obj As Object, ByVal index As
String) As Object
Return obj.[GetType]().InvokeMember("Item",
BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP関数を呼び出し、結果を返します。
'''
''' LISP関数名
''' 引数
'''
Private Function InvokeLispFunction(ByVal funcName As String,
ByVal args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall",
BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP式を評価します。
'''
''' LISP式
'''
_
Public Function Eval(ByVal lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New
Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
acadApp.CommandLinePrompts.Message(vbLf & "LISP式の評価
に失敗しました.")
Return Nothing
End Try
End Function

'''
''' LISP変数から値を取得します。
'''
''' 変数名
'''
Public Function GetValue(ByVal symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP変数に値を代入します。
'''
''' 変数名
''' 値
Public Sub SetValue(ByVal symbolName As String, ByVal val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val +
"))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP変数にnilを代入します
'''
''' 変数名
_
Public Sub SetSymbolsToNil(ByVal ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
End Sub

'''
''' LISTをArrayListに変換します。
'''
''' LISTの入った変数名
'''
Public Function GetLispList(ByVal symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New
Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i,
list}))

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXFコードから情報を取得します。
'''
''' DXFコード
''' 図形名
'''
Private Function getDxfData(ByVal code As Integer, ByVal
symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New
Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object()
{code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIPの選択セットをAcadEntityの配列に変換します。
'''
''' 選択セットの入っている変数名
''' AcadEntity配列の入れ物
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long =
DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New
Object() {ss, i})
ents(i) =
DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5,
en), String))), AcadEntity)

System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIPの選択セットをActiveXの選択セットに変換します。
'''
''' 選択セットの入っている変数名
''' AcadSelectionSetの入れ物
'''
Public Function PickSetToSelectionSet(ByVal symSS As String,
ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function


'''
''' AcadSelectionSetをLISPの選択セットに変換します。
'''
''' AcadSelectionSet
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(ByVal acadSS As
AcadSelectionSet, ByVal symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" +
symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace
Report
0 Likes
Reply
Message 14 of 18
Anonymous
in reply to: Anonymous
‎02-17-2010 03:57 AM
‎02-17-2010 03:57 AM

Converted with help of:
http://converter.telerik.com/
{code}
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Collections
Imports System.Reflection

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common

Imports AcRx = Autodesk.AutoCAD.Runtime
Imports AcEd = Autodesk.AutoCAD.ApplicationServices
Imports AcGe = Autodesk.AutoCAD.Geometry
Imports AcDb = Autodesk.AutoCAD.DatabaseServices
#End Region

Namespace HLIB.Utils
'''
''' VisualLISPと通信。
''' (vl-load-com)を実行してないとだめ。
'''
Public Class Lisp
Implements IDisposable
Private Disposed As Boolean = False
Private m_vlObj As Object
Private m_vlFunc As Object
Private m_app As AcadApplication

'''
''' コンストラクタ
'''
''' AutoCADアプリケーション
Public Sub New(acadApp As AcadApplication)
m_app = acadApp
Try
m_vlObj = acadApp.GetInterfaceObject("VL.Application.16")
Dim acDoc As Object = GetProperty(m_vlObj, "ActiveDocument")
m_vlFunc = GetProperty(acDoc, "Functions")
Catch
AcEd.CommandLinePrompts.Message(vbLf & "VLオブジェクトの取得に失敗しました.")
End Try
End Sub
Protected Overrides Sub Finalize()
Try

Dispose()
Finally
MyBase.Finalize()
End Try
End Sub

'''
''' VlApp によって使用されているリソースを開放します。
'''
Public Sub Dispose()
If Disposed = False Then
m_vlFunc = Nothing
m_vlObj = Nothing
m_app = Nothing
Disposed = True
End If
End Sub

'''
''' COMオブジェクトからプロパティを取得します。
'''
''' 取得元のオブジェクト
''' プロパティ名
'''
Private Function GetProperty(obj As Object, propName As String) As Object
Return obj.[GetType]().InvokeMember(propName, BindingFlags.GetProperty, Nothing, obj, Nothing)
End Function

'''
''' COMオブジェクトからインデクサを取得します。
'''
''' 取得もとのオブジェクト
''' インデックス名
'''
Private Function GetIndexer(obj As Object, index As String) As Object
Return obj.[GetType]().InvokeMember("Item", BindingFlags.GetProperty, Nothing, obj, New Object() {index})
End Function

'''
''' LISP関数を呼び出し、結果を返します。
'''
''' LISP関数名
''' 引数
'''
Private Function InvokeLispFunction(funcName As String, args As Object()) As Object
Dim sym As Object = GetIndexer(m_vlFunc, funcName)
Return sym.[GetType]().InvokeMember("funcall", BindingFlags.InvokeMethod, Nothing, sym, args)
End Function

'''
''' LISP式を評価します。
'''
''' LISP式
'''
Public Function Eval(lispStatement As String) As Object
Try
Dim sym As Object = InvokeLispFunction("read", New Object() {lispStatement})
Return InvokeLispFunction("eval", New Object() {sym})
Catch
AcEd.CommandLinePrompts.Message(vbLf & "LISP式の評価に失敗しました.")
Return Nothing
End Try
End Function

'''
''' LISP変数から値を取得します。
'''
''' 変数名
'''
Public Function GetValue(symbolName As String) As Object
Try
Return Eval(symbolName)
Catch
Return Nothing
End Try
End Function

'''
''' LISP変数に値を代入します。
'''
''' 変数名
''' 値
Public Sub SetValue(symbolName As String, val As Object)
Eval("(vl-load-com)")
Eval("(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)))")
Eval("(setq " + symbolName + " (translate-variant " + val + "))")
Eval("(setq translate-variant nil)")
End Sub

'''
''' LISP変数にnilを代入します
'''
''' 変数名
Public Sub SetSymbolsToNil(ParamArray symbolName As String())
Dim i As Integer = 0
While i < symbolName.Length
Eval("(setq " + symbolName(i) + " nil)")
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
End Sub

'''
''' LISTをArrayListに変換します。
'''
''' LISTの入った変数名
'''
Public Function GetLispList(symList As String) As ArrayList
Dim ret As New ArrayList()
Dim list As Object
Dim len As Long
Try
list = Eval(symList)
len = DirectCast(InvokeLispFunction("length", New Object() {list}), Long)
Dim i As Long = 0
While i < len
ret.Add(InvokeLispFunction("nth", New Object() {i, list}))
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
Catch
End Try
Return ret
End Function

'''
''' DXFコードから情報を取得します。
'''
''' DXFコード
''' 図形名
'''
Private Function getDxfData(code As Integer, symEname As Object) As Object
Dim ent As Object = InvokeLispFunction("entget", New Object() {symEname})
Dim val As Object = InvokeLispFunction("assoc", New Object() {code, ent})
Return InvokeLispFunction("cdr", New Object() {val})
End Function

'''
''' LSIPの選択セットをAcadEntityの配列に変換します。
'''
''' 選択セットの入っている変数名
''' AcadEntity配列の入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef ents As AcadEntity()) As Boolean
Dim ret As Boolean = False
Try
Dim ss As Object = Eval(symSS)
Dim sslength As Long = DirectCast(InvokeLispFunction("sslength", New Object() {ss}), Long)
ents = New AcadEntity(sslength) {}
Dim i As Long = 0
While i < sslength
Dim en As Object = InvokeLispFunction("ssname", New Object() {ss, i})
ents(i) = DirectCast((m_app.ActiveDocument.HandleToObject(DirectCast(getDxfData(5, en), String))), AcadEntity)
System.Math.Max(System.Threading.Interlocked.Increment(i),i - 1)
End While
ret = True
Catch
End Try
Return ret
End Function

'''
''' LSIPの選択セットをActiveXの選択セットに変換します。
'''
''' 選択セットの入っている変数名
''' AcadSelectionSetの入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef acadSS As AcadSelectionSet) As Boolean
Dim ret As Boolean = False
acadSS.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
acadSS.AddItems(ents)
ret = True
End If
Return ret
End Function

'''
''' LSIPの選択セットをObjectIdCollectionに変換します。
'''
''' 選択セットの入っている変数名
''' ObjectIdCollectionの入れ物
'''
Public Function PickSetToSelectionSet(symSS As String, ByRef objIds As AcDb.ObjectIdCollection) As Boolean
Dim ret As Boolean = False
objIds.Clear()
Dim ents As AcadEntity() = Nothing
If PickSetToSelectionSet(symSS, ents) Then
For Each en As AcadEntity In ents
Dim id As New AcDb.ObjectId()
id.OldId = en.ObjectID
objIds.Add(id)
Next
ret = True
End If
Return ret
End Function

'''
''' ObjectIdCollectionをLISPの選択セットに変換します。
'''
''' ObjectIdCollection
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(objIds As AcDb.ObjectIdCollection, symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each id As AcDb.ObjectId In objIds
Eval("(ssadd (handent """ + id.Handle + """)" + symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function

'''
''' AcadSelectionSetをLISPの選択セットに変換します。
'''
''' AcadSelectionSet
''' 選択セットを入れる変数名
'''
Public Function SelectionSetToPickSet(acadSS As AcadSelectionSet, symSS As String) As Boolean
Dim ret As Boolean = False
Try
Eval("(setq " + symSS + " (ssadd))")
For Each en As AcadEntity In acadSS
Eval("(ssadd (handent """ + en.Handle + """)" + symSS + ")")
Next
ret = True
Catch
End Try
Return ret
End Function
End Class
End Namespace

'=======================================================
'Service provided by Telerik (www.telerik.com)
'Conversion powered by NRefactory.
'Built and maintained by Todd Anglin and Telerik
'=======================================================

{code}

~'J'~
Report
0 Likes
Reply
Message 15 of 18
jerry.bryant
Advocate
in reply to: Anonymous
‎08-11-2010 10:11 AM
‎08-11-2010 10:11 AM

What are all the "special chars" showing up in the code?

Jerry Bryant
"Swing hard and hope you hit it!"
Report
0 Likes
Reply
Message 16 of 18
caddzone
Collaborator
in reply to: jerry.bryant
‎08-11-2010 11:41 AM
‎08-11-2010 11:41 AM

The forum software appears to have done that.

 



AcadXTabs for AutoCAD
Supporting AutoCAD 2000-2011


Report
0 Likes
Reply
Message 17 of 18
wrighte
Alumni
in reply to: caddzone
‎08-11-2010 02:17 PM
‎08-11-2010 02:17 PM

Tony - any chance you still have the original code (or part of it)  Can use that to troubleshoot why it may have changed with the data migration.

 



Eric Wright
Sr. Web Product Manager
Autodesk Knowledge Network
Autodesk, Inc.
Report
0 Likes
Reply
Message 18 of 18
caddzone
Collaborator
in reply to: wrighte
‎08-11-2010 05:49 PM
‎08-11-2010 05:49 PM

No, sorry I don't have it, but someone here probably does.



AcadXTabs for AutoCAD
Supporting AutoCAD 2000-2011


Report
0 Likes
Reply
Reply

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost

 

Report a website issue