自动加载VBA程序的函数

st788796

1. (vl-load-com)
   
2. ;;自动加载VBA程序的函数
   
3. (defun AutoVBALoad (app cmdliste flag / qapp strcmd)
   
4.   (setq qapp (strcat "\"" app "\""))
   
5.   (mapcar
   
6.     '(lambda (cmd / nom_cmd dot nodotcmd)
   
7.        (progn
   
8.          (setq dot (vl-string-search "." cmd))
   
9.          (if dot
   
10.            (setq nodotcmd (substr cmd (+ dot 2)))
    
11.            (setq nodotcmd cmd)
    
12.          )
    
13.          (setq nom_cmd (strcat "C:" nodotcmd))
    
14.          (if (member stat '(0 1 2 3 4 5 6 7))
    
15.            (setq strcmd
    
16.                  (strcat"(vlax-add-cmd \"" nodotcmd "\" \'"
    
17.                         nom_cmd "\"" nodotcmd "\"" (itoa flag) " ))"))
    
18.          )
    
19.          (eval
    
20.            (read (strcat
    
21.                    "(defun " nom_cmd "(/ app)"
    
22.                      "(if (setq app(fdvbfile " qapp "))"
    
23.                        "(progn(vla-runmacro (vlax-get-acad-object) (strcat app \"!" cmd "\"))"
    
24.                        strcmd
    
25.                        "(nodvbfile " qapp "))"
    
26.                    "(princ ))"
    
27.        )))))
    
28.     cmdliste
    
29.   )
    
30.   (princ)
    
31. )
    
32. (defun fdvbfile (app)
    
33.   (if (not (findfile app))
    
34.     (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
    
35. )
    
36. (defun nodvbfile (filename)
    
37.   (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
    
38.   (princ "\n请检查支持文件的安装，然后重试。")
    
39.   (princ)
    
40. )
    
41. ;;自动加载VBA程序
    
42. (AutoVBALoad "ChangColor" '("CC") 3)
    
43. (AutoVBALoad "Zoom" '("ZP" "ZA" "ZE" "ZW") 1)

(vl-load-com)<br /> ;;自动加载VBA程序的函数 <br /> (defun AutoVBALoad (app cmdliste flag / qapp strcmd)<br />   (setq qapp (strcat "\"" app "\""))<br />   (mapcar<br />     '(lambda (cmd / nom_cmd dot nodotcmd)<br />        (progn<br />          (setq dot (vl-string-search "." cmd))<br />          (if dot<br />            (setq nodotcmd (substr cmd (+ dot 2)))<br />            (setq nodotcmd cmd)<br />          )<br />          (setq nom_cmd (strcat "C:" nodotcmd))<br />          (if (member stat '(0 1 2 3 4 5 6 7)) <br />            (setq strcmd <br />                  (strcat"(vlax-add-cmd \"" nodotcmd "\" \'" <br />                         nom_cmd "\"" nodotcmd "\"" (itoa flag) " ))"))<br />          )<br />          (eval<br />            (read (strcat<br />                    "(defun " nom_cmd "(/ app)"<br />                      "(if (setq app(fdvbfile " qapp "))"<br />                        "(progn(vla-runmacro (vlax-get-acad-object) (strcat app \"!" cmd "\"))"<br />                        strcmd<br />                        "(nodvbfile " qapp "))"<br />                    "(princ ))"<br />        )))))<br />     cmdliste<br />   )<br />   (princ)<br /> )<br /> (defun fdvbfile (app)<br />   (if (not (findfile app))<br />     (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)<br /> )<br /> (defun nodvbfile (filename)<br />   (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))<br />   (princ "\n请检查支持文件的安装，然后重试。")<br />   (princ)<br /> )<br /> ;;自动加载VBA程序 <br /> (AutoVBALoad "ChangColor" '("CC") 3)<br /> (AutoVBALoad "Zoom" '("ZP" "ZA" "ZE" "ZW") 1)

GTJ116600

为方便理解程序，搜了一下VBA自动安装方法 供参考

mikenjohn
大约有如下几种方法：
1、vba自己加载法。将你的vba工程文件改名为acad.dvb，放在cad的安装目录下，vba初始化后自动加载。
2、startup加载法。将你的vba文件放到cad的安装目下。cad安装目录下和suport目录下搜索acad.lsp文件，如果不存在，用windows记事本在安装目录下新建一个acad.lsp文件（如果已经存在，用记事本打开它），在该文件中添加如下内容：
(defun S::STARTUP()
(command "_VBALOAD" "myproj.dvb")
)
保存后退出，以后启动cad会自动加载，其中myproj.dvb是你的vba工程文件名。
以上是autodesk推荐的两种方法，其实还有第三种方法。


3、lisp加载法。用记事本打开support目录下的acad200x.lsp，其中200x与acad的版本对应（如acad2000对应acad2000.lsp,acad2002对应acad2002.lsp等等），在文件的最后添加如下语句：
(vl-vbaload "myproj.dvb")