社区 › AutoCAD与GIS测绘 › 请各位LSP大神帮助改编写个ActiveDLL调用模块

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

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

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

本帖最后由 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:10

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

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

非常感谢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:17

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

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

查看完整版本: 请各位LSP大神帮助改编写个ActiveDLL调用模块