[原创]AutoCAD二次开发程序的安装制作向导（测试），支持2006

秋枫发表于 2005-4-10 01:16:00

以前我发表过一个LISP Setup用于简单的LISP程序的安装。这个程序需要设置AutoCAD菜单文件。而一些坛友对于必须要用菜单文件也很不爽。毕竟这样就不够简单了。而从AutoCAD 2006开始，菜单文件发生了变化，尤其是它的注册表结构变了。这个程序基本上废了。 近日我重新弄了一个。目标是更加简单。现在支持AutoCAD 2006，但不再支持AutoCAD R14了。希望它可以自动支持后续的AutoCAD版本。给大家测试一下先：

尝鲜下载：<A href="http://quelea.w3.zccn.net/blogview.asp?logID=42" target="_blank" >http://quelea.w3.zccn.net/blogview.asp?logID=42</A>

后面我有空会提供更加详细一点的信息。欢迎讨论。

spshchen 发表于 2005-4-10 09:39:00

好东西,但是我不知道,如何增加支持文件搜索路径.

wdb 发表于 2005-4-10 11:29:00

下载后看看

秋枫发表于 2005-4-10 12:31:00

spshchen发表于2005-4-10 9:39:00static/image/common/back.gif好东西,但是我不知道,如何增加支持文件搜索路径.
这个我会稍后写个教程解释一下。我先贴一段例程，这段你可以参考修改后加到启动时自动加载的文件中去。;; 取得本安装程序的路径
;; AppID即为本次安装所使用的ID
(defun GetApplicationPath (AppID)
(vl-registry-read
   (strcat
      "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\"
      AppID
      "_is1"
   )
   "Inno Setup: App Path"
)
);;;AddSupportPath
;;;添加文件夹到AutoCAD支持搜索路径中的指定位置
;;;参数
;;;文件夹路径及插入的位置(0时插入前端)
;;;示例
;;;(addSupportPath "c:\\myFolder" 2)
;;;注意
;;;位置参数为空时将文件夹添加到路径最后。位置参数为0时将文件夹添加到路径最前端。
(defun addSupportPath (dir pos / tmp c)
(setqtmp ""
c -1
)
(if (not pos)
   (setq tmp (strcat (getenv "ACAD") ";" dir))
   (mapcar '(lambda (x)
            (setq tmp (if (= (setq c (1+ c)) pos)
      (strcat tmp ";" dir ";" x)
      (strcat tmp ";" x)
   )
            )
      )
      (parse (getenv "ACAD") ";")
   )
)
(setenv "ACAD" tmp)
(princ)
);;;removeSupportPath
;;;从AutoCAD支持搜索路径中移去指定文件夹
;;;参数
;;;所要移去的文件夹
;;;示例
;;;(removeSupportPath "c:\myFolder")
(defun removeSupportPath (dir / tmp)
(setq tmp "")
(mapcar '(lambda (x)
      (if (/= (strcase x) (strcase dir))
            (setq tmp (strcat tmp x ";"))
      )
   )
(parse (getenv "ACAD"))
)
(setenv "ACAD" (substr tmp 1 (1- (strlen tmp))))
(princ)
);; 加载菜单样例：
(defun AddDemoMenu ()
(if (menugroup "DemoMenu"); 菜单组名为DemoMenu, 已经加载
   (progn
      (command "_menuunload" "DemoMenu")
      (command "_menuload" "DemoMenu.mnu")
      (menucmd "p8=+DemoMenu.pop1")
      (menucmd "p9=+DemoMenu.pop2")
      (menucmd "p10=+DemoMenu.pop3")
      (princ "\n DemoMenu 菜单载入.")
   )
   (progn
      (command "_menuload" "DemoMenu.mnu")
      (menucmd "p8=+DemoMenu.pop1"); 插在第8个位子
      (menucmd "p9=+DemoMenu.pop2"); 插在第8个位子
      (menucmd "p10=+DemoMenu.pop3"); 插在第10个位子
      (princ "\n DemoMenu 菜单载入.")
   )
)
)

spshchen 发表于 2005-4-10 12:51:00

太好了,我刚需要这个东西,这样我就可以做个自己的工具集了,

wengsg 发表于 2005-4-22 17:22:00

我安装了程序后，命令程序是可以用，但在CAD2005里看不到我的菜单，帮帮忙。

我的原文件：

1、wltool2005.mnu

***MENUGROUP=WLTOOL ***POP1

[实用工具(&A)] ID_TCCC [图层(&)]^C^Cjccc ID_CLHWTA [地质岩性(&H)]^C^C$i=WLTOOL.KUAWEN $i=* ID_iFM 　　 [测绘图库(&I)]^C^C$i=WLTOOL.DOOR $i=* ID_TT 　　 ^C^CTT ID_gch 　　 [高程点输入(&t)]^C^CTT0 ID_linetopl　 [转换LINE线至LWPOLYLINE(&t)]^C^Clinetopl ID_lwtopl　　 [转换LWPOLYLINE线至POLYLINE(&t)]^C^Clwtopl ID_linetype 　 [定制线型(&L)]^C^C-linetype ID_tl 　 [地质图例(&D)]^C^C$i=WLTOOL.dzht $i=*

[--] ID_MnEXDraw [总图线型]^C^C$i=WLTOOL.FSLTCHG $i=* [绿化线型]^C^C$i=WLTOOL.TREELT $i=*

2、wltool.lsp

;;; 判断是否加载本文件 (if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com) ;;else (progn (Alert "这个程序集是为AutoCAD 2000以及更高的版本设计的，许多程序有可能在没有Visual Lisp for R14支持的AutoCAD R14上不能正确地运行。" ) (exit) ; 版本不符，退出加载。 ) ) ;;; 以下定义文件中用到的函数 ;;;----------------------------------------------------------------------------------

;;; 取得本程序的路径 ;;; --------------------------------------------------------------------------------- (defun GetMyApplicationPath (AppID) (vl-registry-read (strcat "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\" AppID "_is1" ) "Inno Setup: App Path" ) )

(defun GetWLTOOLPath () (GetMyApplicationPath "WLTOOL for AutoCAD") )

;;; 解析字符串为表（函数来自明经通道转载） ;;; --------------------------------------------------------------------------------- (defun strParse (Str Delimiter / SearchStr StringLen return n char) (setq SearchStr Str) (setq StringLen (strlen SearchStr)) (setq return '()) (while (&gt StringLen 0) (setq n 1) (setq char (substr SearchStr 1 1)) (while (and (/= char Delimiter) (/= char "")) (setq n (1+ n)) (setq char (substr SearchStr n 1)) ) ;_ end of while (setq return (cons (substr SearchStr 1 (1- n)) return)) (setq SearchStr (substr SearchStr (1+ n) StringLen)) (setq StringLen (strlen SearchStr)) ) ;_ end of while (reverse return) ) ;_ end of defun

;;; 反解析表为字符串（函数来自明经通道转载） ;;; --------------------------------------------------------------------------------- (defun StrUnParse (Lst Delimiter / return) (setq return "") (foreach str Lst (setq return (strcat return Delimiter str)) ) ;_ end of foreach (substr return 2) ) ;_ end of defun

;;; 移除支持文件搜索路径 ;;; --------------------------------------------------------------------------------- (defun QF_RemoveSupportPath (PathToRemove / supportlist) (setq supportlist (strparse (getenv "ACAD") ";")) (setq supportlist (vl-remove "" supportlist)) (setq supportlist (vl-remove-if '(lambda (x) (= (strcase x) (strcase PathToRemove))) supportlist ) ) (setenv "ACAD" (strUnParse supportlist ";")) )

;;; 添加支持文件搜索路径 ;;; --------------------------------------------------------------------------------- ;;; note: 第二个参数如果为真, 插最前，否则插最后 ;;; (defun QF_AddSupportPath (PathToAdd isFirst / supportlist) (QF_RemoveSupportPath PathToAdd) (setq supportlist (strparse (getenv "ACAD") ";")) (setq supportlist (vl-remove "" supportlist)) (if isFirst (setq supportlist (cons PathToAdd supportlist)) (setq supportlist (append supportlist (list PathToAdd))) ) (setenv "ACAD" (strUnParse supportlist ";")) )

;;; 根据不同的AutoCAD版本加载不同的菜单文件： (defun Load_WLTOOLMenu (/ acadver) (setq acadver (atof (getvar "acadver"))) (cond ((and (&gt = acadver 15.0) (&lt acadver 16.0) ) (command "_menuload" "WLTOOL.mnu") ) ((and (&gt = acadver 16.0) (&lt= acadver 16.1) ) (command "_menuload" "WLTOOL2005.mnu") ;| ((&gt;= acadver 16.2) (command "_menuload" "QTools2006.mnu")) ) ) |; ;;; The following code "placemenu" written by LUCAS ;;; 插入菜单条 Placemenu由LUCAS编写 ;;; --------------------------------------------------------------------------------- (defun WLTOOL_PlaceMenu (/ n) (if (menugroup "WLTOOL") (progn (setq n 1) (while (&lt n 24) (if (menucmd (strcat "P" (itoa n) ".1=?")) (setq n (+ n 1)) (progn (if (&gt n 3) (setq n (- n 2)) (setq n 3)

) ;if (menucmd (strcat "p" (itoa n) "=+WLTOOL.pop3") ) (menucmd (strcat "p" (itoa n) "=+WLTOOL.pop2") ) (menucmd (strcat "p" (itoa n) "=+WLTOOL.pop1") ) (setq n 25) ) ;progn ) ;if ) ) ;while ) ;progn ) ;if (princ) )

;;; 初始化主函数 ;;; --------------------------------------------------- (defun Init_WLTOOL () ;; 添加支持路径 (QF_AddSupportPath (GetWLTOOLPath) nil) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://DOOR/" target="_blank" >\\DOOR</A>") nil ) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://FONTS/" target="_blank" >\\FONTS</A>") nil ) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://LINE/" target="_blank" >\\LINE</A>") nil ) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://LISP/" target="_blank" >\\LISP</A>") nil ) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://PAT/" target="_blank" >\\PAT</A>") nil ) (QF_AddSupportPath (strcat (GetWLTOOLPath) "<A href="file://SLB/" target="_blank" >\\SLB</A>") nil )

;; 如果菜单组还没有被加载，则加载之 (if (not (menugroup "WLTOOL")) (Load_WLTOOLMenu) )

;; 安排菜单条的位置 (WLTOOL_PlaceMenu)

(princ) ) ) ;;; 以上函数部分定义完毕

;;; ----------------------------------------------------- ;;; 主程序： ;;; ----------------------------------------------------- (princ "\n加载WLTOOL工具集……")

(setq WLTOOL_cmdecho_save (getvar "cmdecho")) (setvar "cmdecho" 0)

;;; 执行初始化 (Init_WLTOOL)

(setvar "cmdecho" WLTOOL_cmdecho_save) (setq WLTOOL_cmdecho_save nil)

(princ "\nWLTOOL工具集加载完毕。版本 2005.4") (princ)

;; autoload (autoload "wltool" '("JC" "JCCC" "WL" "LWTOPL2")) ;; ……下略 )

onej 发表于 2005-4-22 18:33:00

请问一个问题: 在ISetup制作安装向导的时候,如何在开始安装之前判别系统有没有装AUTOCAD,就象秋枫以前的那个安装向导一样,我知道是读注册表,但具体的实现还是不会,能指点指点吗?

didini 发表于 2005-4-22 19:16:00

多谢！不过需要好好研究了！

秋枫发表于 2005-4-22 20:46:00

本帖最后由作者于 2005-4-23 9:58:25 编辑 wengsg发表于2005-4-22 17:22:00static/image/common/back.gif(menucmd (strcat \"p\" (itoa n) \"=+WLTOOL.pop3\") ) (menucmd (strcat \"p\" (itoa n) \"=+WLTOOL.pop2\") ) (menucmd (strcat \"p\" (itoa n) \"=+WLTOOL.pop1\") ) ...

这里你只有一条菜单，因此，

(menucmd (strcat "p" (itoa n) "=+WLTOOL.pop3") ) (menucmd (strcat "p" (itoa n) "=+WLTOOL.pop2") )

这两句是多余的，而且我认为会导致LSP出错，从这里中断执行。因此后面的代码没有执行。

你可以在Vlisp调试器中逐句单步执行测试。 

另，你的贴文中的&gt符号之类的不知你原文是否存在……这个也是不对头的。我前面贴的源代码中有这些东东是因为明经通道的论坛的原因，自动转化了一些符号。我现在已经改过来了。请重新拷贝。

这个样例LISP程序只是我提供的一个解决方案。你完全可以不必照搬。如果其中有什么错误或不妥我相信各高手也会有自己的看法。因为它是纯lisp程序，我相信大家自己搞得定的。在晓东cad空间论坛上我也贴了这个教程，有些网友对这段代码作了改进，我觉得也挺不错的。

秋枫发表于 2005-4-22 21:08:00

onej发表于2005-4-22 18:33:00static/image/common/back.gif请问一个问题:在ISetup制作安装向导的时候,如何在开始安装之前判别系统有没有装AUTOCAD,就象秋枫以前的那个安装向导一样,我知道是读注册表,但具体的实现还是...

 如果ISetup是指Inno Setup的话，在Code段写下：

const AutoCADKey = 'Software\Autodesk\AutoCAD';

function AutoCADInstalled: boolean; begin Result:=RegKeyExists(HKLM, AutoCADKey); end; 

function InitializeSetup(): Boolean; var begin Result := AutoCADInstalled; end;

页: [1] 2 3

明经CAD社区's Archiver

[原创]AutoCAD二次开发程序的安装制作向导（测试），支持2006