明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1480|回复: 0

请各们LSP大神改写一个VBA程序调用ActiveDLL

[复制链接]
发表于 2013-11-11 10:33:56 | 显示全部楼层 |阅读模式
已经编写好多个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









您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-16 00:40 , Processed in 0.169436 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表