- 积分
- 10755
- 明经币
- 个
- 注册时间
- 2005-6-8
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2014-3-25 15:24:36
|
显示全部楼层
- ''' <summary>
- ''' 用.NET来运行Lisp的工具
- ''' </summary>
- ''' <remarks>1.实例化后,先LoadLisp</remarks>
- Public Class LispInDotNet
- Private mVlFunctions As Object = Nothing
- ''' <summary>
- ''' Lisp的函数对象集
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property VlFunctions As Object
- Get
- Return mVlFunctions
- End Get
- End Property
- Private mLoadSuccessful As Boolean = False
- ''' <summary>
- ''' 是否加载成功
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property LoadSuccessful As Boolean
- Get
- Return mLoadSuccessful
- End Get
- End Property
- ''' <summary>
- ''' 加载Lisp运行环境
- ''' </summary>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function LoadLisp() As Boolean
- '状态:20131126-1348测试通过
- Try
- Dim acadApp As Object = Autodesk.AutoCAD.ApplicationServices.Application.AcadApplication
- Dim vlApp As Object = acadApp.GetInterfaceObject("VL.Application.16") '此处出错,可能是因为没有加载VL环境所致, (vl-load-com)
- 'VL.Application.16 为什么会是16?到AutoCAD各版本的安装目录里到查找,会发现一个vl16.tlb,这个文件就是visual lisp的运行环境,到AutoCAD 2014为止,这个文件一直没有更新。
- mVlFunctions = vlApp.ActiveDocument.Functions
- mLoadSuccessful = True
- Return True
- Catch ex As Autodesk.AutoCAD.Runtime.Exception
- Return False
- End Try
- End Function
- ''' <summary>
- ''' 运行Lisp函数
- ''' </summary>
- ''' <param name="FunctionName"></param>
- ''' <param name="args">参数数组</param>
- ''' <param name="runSuccessful">是否运行成功</param>
- ''' <param name="ErrMsg">出错信息</param>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function RunLispFunction(ByVal FunctionName As String, args() As Object, Optional ByRef runSuccessful As Boolean = False, Optional ByRef ErrMsg As String = "") As Object
- '状态:20131126-1711通过测试
- runSuccessful = False
- If Me.LoadSuccessful = True Then
- If Me.HasLispFunction(FunctionName) = False Then
- Return Nothing
- End If
- Try
- Dim vlFunction As Object = mVlFunctions.Item(FunctionName)
- RunLispFunction = vlFunction.GetType.InvokeMember("funcall", BindingFlags.InvokeMethod, Nothing, vlFunction, args)
- runSuccessful = True
- Catch ex As System.Reflection.TargetInvocationException
- ErrMsg = ex.Message
- Return Nothing
- End Try
- Else
- Return Nothing
- End If
- End Function
- ''' <summary>
- ''' 查询当前环境是否有某个Lisp函数或者变量
- ''' </summary>
- ''' <param name="functionNameOrValueName"></param>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function HasLispFunction(ByVal functionNameOrValueName As String) As Boolean
- '状态:20131126-1534通过测试
- Dim vlFunction As Object = mVlFunctions.Item("read")
- Dim sym As Object = vlFunction.GetType.InvokeMember("funcall", BindingFlags.InvokeMethod, Nothing, vlFunction, New Object() {functionNameOrValueName})
- If sym Is Nothing Then
- Return False
- Else
- Dim vlFuncEval As Object = mVlFunctions.Item("eval")
- If vlFunction.GetType.InvokeMember("funcall", BindingFlags.InvokeMethod, Nothing, vlFuncEval, New Object() {sym}) Is Nothing Then
- Return False
- Else
- Return True
- End If
- End If
- End Function
- ''' <summary>
- ''' 获取Lisp变量的值
- ''' </summary>
- ''' <param name="ValueName"></param>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function GetValue(ValueName As String) As Object
- '状态:20131126-1534通过测试
- Return Eval(ValueName)
- End Function
- ''' <summary>
- ''' 获取一个Lisp语句的值
- ''' </summary>
- ''' <param name="LispString"></param>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function Eval(LispString As String) As Object
- '状态:20131126-1534通过测试
- Try
- Dim sym As Object = RunLispFunction("read", New Object() {LispString})
- If sym Is Nothing Then
- Return Nothing
- Else
- Return RunLispFunction("eval", New Object() {sym})
- End If
- Catch ex As Exception
- Return Nothing
- End Try
- End Function
- ''' <summary>
- ''' 设置Lisp变量的值
- ''' </summary>
- ''' <param name="ValueName">变量名</param>
- ''' <param name="Value">变量值</param>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public Function SetValue(ByVal ValueName As String, ByVal Value As Object) As Boolean
- '状态:20131126-1534通过测试
- Dim suc As Boolean = False, errMsg As String = ""
- Dim sym As Object = Me.RunLispFunction("read", New Object() {ValueName}, suc, errMsg)
- If suc Then
- Me.RunLispFunction("set", New Object() {sym, Value}, suc, errMsg)
- If suc Then
- Return True
- Else
- Return False
- End If
- Else
- Return False
- End If
- End Function
- End Class
有兴趣的话,可以参考一下。 |
|