请各们LSP大神改写一个VBA程序调用ActiveDLL
已经编写好多个ActiveDLL模块，现需要LISP高手帮助编写以下功能的LISP模块一、当CAD启动时，自动判断当前CAD版本，然后根据版本分别调用以下模块加载初始化、菜单、工具条
CAD2004时：调用zjqtoolgcd04.dll中 zjqtoolgcd.gcd04类中的ml子程序
CAD2008时：调用zjqtoolgcd08.dll中 zjqtoolgcd.gcd08类中的ml子程序
CAD2010时：调用zjqtoolgcd10.dll中 zjqtoolgcd.gcd10类中的ml子程序
ml全局子程序调用接口定义为：
public sub ml(byval str1 as string) ,在lisp程序中将"menuload"字符串传递到ml子程序即可，子程序自动根子符串判断并调用相应功能模块。
因为对lisp所知甚少，只知道可以实现但不会编写相应的代码，目前解决办法在网上找到的代码，先建立一个LSP程序，其中代码为
zjqtool.LSP
(princ
"\n正在加载ZJQTOOL工具"
)
(defun S::STARTUP ()
(command "_-vbarun" "zjqmenu")
)
然后在DVB中有一建立一个子程序:zjqmenu(),
Sub zjqmenu() 'CAD启动时加载菜单并初始化一些设置
Dim AppDll As Object ‘定义接口变量
On Error Resume Next
Select Case Val(Left(ThisDrawing.Application.Version, 2)) ’根据CAD版本号前两位判断CAD的版本，如Version=18.2则调用zjqtoolgcd.gcd10类
Case 16 'CAD2004调用zjqtoolgcd.gcd04类
Set AppDll = CreateObject("zjqtoolgcd.gcd04")
Case 17
Set AppDll = CreateObject("zjqtoolgcd.gcd08") 'CAD2008调用zjqtoolgcd.gcd08类
Case 18
Set AppDll = CreateObject("zjqtoolgcd.gcd10") 'CAD2010调用zjqtoolgcd.gcd10类
Case Else
End Select
Call AppDll.ml("MENULOAD") '调用ml子程序并传递字符串"MENULOAD"
Set AppDll = Nothing
End Sub
现请各位LSP高手将VBA程序zjqmenu（）改写成LSP程序
二、当CAD中进行新建文件和打开文件操作时，调用改定出来的的zjqmenu（）子程序，当进行其它操作时不作反应。
目前的解决办法是在DVB文件全局模块thisdrawing下加入一个模块，当CAD执行完命令后模块会检查是否是打开文件或新建文件操作，然后调用zjqmenu()模块。
附上DVB原代码：
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If UCase("CommandName") = "NEW" Or UCase("CommandName") = "OPEN" Then Call zjqmenu
End Sub
以上两个功能的目的是在CAD第一次打开时进行一次初始化操作，然后在新建或打开其它的图纸时也进行一次初始化操作。
三、编写一个LSP子程序，能接受Active功能菜单的调用，并且能接收一个子符串参数，对字符串进行分析后调用不同的类模块中的ml(),并将字符串中的一部分传递到ml()模块
具体要求是：当点击工具条上的某个按钮后，ActiveDLL将调用LSP中的zjqtool()模块，并向LSP中的zjqtool()传递一个字符串"1,ABCD" ,"2,abcde","3,scddd"等等，LSP中的zjqtool()负责将这个字符串中的数字部分提取出来，根据数字不同调用不同的类模块中的ml(),并将接收到的字符串中逗号以后的字符串传递给类模块中的ml()模块。要求这个LSP程序zjqtool()模块同样具有自动判断CAD版本的功能，调用不同版本的Active类中对应的ml()模块
附上VBA原程序：
Sub zjqtool()
'CAD运行过程中调用不同功能模块
Dim a As String, i As Integer, c As Integer
Dim AppDll As Object
Dim b() As String
a = ThisDrawing.Utility.GetString(False)
b = Split(a, ",")
i = UBound(b)
If i > 0 Then
c = b(0)
a = b(1)
End If
Select Case c
Case 1 ‘ 收到参数为"1,abcd"，调用zjqtoolgcd
If Val(Left(ThisDrawing.Application.Version, 2)) = 16 Then Set AppDll = CreateObject("zjqtoolgcd.gcd04")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtoolgcd.gcd08")
If Val(Left(ThisDrawing.Application.Version, 2)) = 18 Then Set AppDll = CreateObject("zjqtoolgcd.gcd10")
Call AppDll.ml(a) '调用activedll中的ml,并传递"ABCD"给ml
Case 2 ‘ 收到参数为"2,abcd"，调用zjqtooldtm
If Val(Left(ThisDrawing.Application.Version, 2)) = 16 Then Set AppDll = CreateObject("zjqtooldtm.dtm04")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooldtm.dtm08")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooldtm.dtm08")
Call AppDll.ml(a)'调用activedll中的ml,并传递"ABCD"给ml
Case 3 ' 收到参数为"3,abcd"，调用zjqtooldgx
If Val(Left(ThisDrawing.Application.Version, 2)) = 16 Then Set AppDll = CreateObject("zjqtooldgx.dgx04")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooldgx.dgx08")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooldgx.dgx10")
Call AppDll.ml(a) '调用activedll中的ml,并传递"ABCD"给ml
Case 4 ‘ 收到参数为"4,abcd"，调用zjqtooloth
If Val(Left(ThisDrawing.Application.Version, 2)) = 16 Then Set AppDll = CreateObject("zjqtooloth.oth04")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooloth.oth08")
If Val(Left(ThisDrawing.Application.Version, 2)) = 17 Then Set AppDll = CreateObject("zjqtooloth.oth10")
Call AppDll.ml(a) '调用activedll中的ml,并传递"ABCD"给ml
Case Else '其它情况，不作处理，只给一个提示
ThisDrawing.Utility.Prompt ("未知命令" & vbCrLf)
End Select
End Sub
页:
[1]