请各位LSP大神帮助改编写个ActiveDLL调用模块

poly168 · 发表于 2013-11-11 10:29

已经编写好多个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
各位LSP大神们请你们帮帮小弟一把

yshf · 发表于 2013-11-11 12:29

本帖最后由 yshf 于 2013-11-11 12:30 编辑

(defun zjqmenu() ; 'CAD启动时加载菜单并初始化一些设置
(vl-load-com)
(setq bbh (atoi (getvar "acadver"))
;根据CAD的不同版本选择不同的ActiveDLL模块
Act (cond ((= bbh 16) "zjqtoolgcd.gcd04")
((= bbh 17) "zjqtoolgcd.gcd08")
((= bbh 18) "zjqtoolgcd.gcd10")
)
)
(if (setq AppDll (vlax-create-object Act))
(progn
(vlax-invoke-method AppDll "ml" "MENULOAD")
(vlax-release-object AppDll)
(setq AppDll nil)
)
(alert (strcat "不能创建"" Act ""实例对象!"))
)
(princ)
)

其它仿此编写

poly168 · 发表于 2013-11-11 13:40

十分感谢yshf ，我试了一下把(defun zjqmenu() 改成(defun c:zjqmenu() 可以直接运行
能否再烦你改一下第一个和最后一个小程序？不胜感激

poly168 · 发表于 2013-11-11 17:06

非常感谢yshf的代码，现在第三项功能已经根据你的代码改写完成，可以正确运行，加载菜单也没什么问题，但是不知什么原因，下面的代码在CAD启动时自动运行后出错
(defun S::STARTUP ()
(zjqmenu)
)
错误: Automation 错误。 ActiveX 部件不能创建对象，但CAD启动好后我在命令行输入zjqload调用zjqmenu程序又能正确创建Active对象，是不是因为LSP加载顺序是在CAD没有完成初始化的原因，请高手们邦助改一下下面的程序，目标是当CAD启动好后自动加载初始化和菜单部分。

(defun zjqmenu()
(vl-load-com)
(setq bbh (atoi (getvar "acadver"))
      Act (cond ((= bbh 16) "zjqtoolgcd.gcd04")
                  ((= bbh 17) "zjqtoolgcd.gcd08")
                  ((= bbh 18) "zjqtoolgcd.gcd10")
            )
)
(if (setq AppDll (vlax-create-object Act))
      (progn
         (vlax-invoke-method AppDll "ml" "MENULOAD")
         (vlax-release-object AppDll)
         (setq AppDll nil)
      )
   (alert (strcat "不能创建\"" Act "\"实例对象"))
)
(princ)
)

(defun S::STARTUP ()
(zjqmenu)
)

(defun C:zjqload ()
(zjqmenu)
)

革天明 · 发表于 2014-10-22 08:37

poly168 发表于 2013-11-11 17:06
非常感谢yshf的代码，现在第三项功能已经根据你的代码改写完成，可以正确运行，加载菜单也没什么问题，但是 ...

Automation 错误
你看看是不是DLL没有注册？另外AutoCAD的适用性更好，中望之类的容易出错。

账号		自动登录	找回密码
密码			注册

请各位LSP大神帮助改编写个ActiveDLL调用模块

相关帖子