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

onej

谢谢秋枫，可编译错误啊，

didini

(while (&gt “这个到底是什么啊？”StringLen 0)
(setq n 1)
(setq char (substr SearchStr 1 1))
(while (and (/= char Delimiter) (/= char ""))
(setq n (1+ n))

秋枫

onej发表于2005-4-22 21:31:00谢谢秋枫，可编译错误啊，17969

笔误，不好意思。把var行去掉即可。 var行用于定义内部变量，这个函数没有内部变量，所以多余，去掉即可。

秋枫

didini发表于2005-4-22 21:42:00(while (&gt “这个到底是什么啊？”StringLen 0) (setq n 1) (setq char (substr SearchStr 1 1)) ...

是明经通道论坛自动转化了大于符号（尖括号）。现已修正。请重新拷贝。

wengsg

还是没用! 程序如下: ;;; 判断是否加载本文件
(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 (> 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 ";"))
)
(defun Load_WLTOOLMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acadver 16.0))
(command "_menuload" "WLTOOL.mnu")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "WLTOOL2004.mnu")
)
((>= acadver 16.2) (command "_menuload" "WLTOOL2006.mnu"))
)
) ;;; The following code "placemenu" written by LUCAS
;;; 插入菜单条 Placemenu由LUCAS编写
;;; ---------------------------------------------------------------------------------
(defun WLTOOL_PlaceMenu (/ n)
(if (menugroup "WLTOOL")
(progn
(setq n 1)
(while (< n 24)
(if (menucmd (strcat "P" (itoa n) ".1=?"))
(setq n (+ n 1))
(progn
(if (> n 3)
(setq n (- n 2))
(setq n 3)
) ;if (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) "\\DOOR") nil)
(QF_AddSupportPath (strcat (GetWLTOOLPath) "\\FONTS") nil)
(QF_AddSupportPath (strcat (GetWLTOOLPath) "\\LINE") nil)
(QF_AddSupportPath (strcat (GetWLTOOLPath) "\\LISP") nil)
(QF_AddSupportPath (strcat (GetWLTOOLPath) "\\PAT") nil)
(QF_AddSupportPath (strcat (GetWLTOOLPath) "\\SLB") 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 "CWCT" '("CHANGE-THICKNESS" "CHANGE-WIDTH"))
;; ……下略

秋枫

朋友，你这个是纯LISP问题啊，你可以用VLISP设断点调试看看什么地方错了呀。 我猜一下： (defun GetWLTOOLPath ()
(GetMyApplicationPath "WLTOOL for AutoCAD")
) 这个的返回值对不对？“WLTOOL for AutoCAD”是不是与安装向导中的设置一致？

wengsg

是这个"这个的返回值对不对？“WLTOOL for AutoCAD”是不是与安装向导中的设置一致？"原因.谢谢!


但我的菜单还是无法自动加载.


       

wengsg

谢谢楼主,我的问题已解决!

didini

经过一天的努力终于解决了！


但是有个问题，在制作setup文件的时候，需要制作一个自动加载的lisp文件，或者其它的文件，在这个文件中实现添加支持路径和菜单文件，当安装上setup以后，第一次打开cad，就会发现，在新添加路径中的acaddoc.lsp，并没有加载，但在以后就不会出现这样的情况了！


这种情况能避免吗？

秋枫

既然提供了自动加载文件，就没有必要使用acaddoc.lsp. 因为这个自动加载文件每次都会加载的。



因为这个文件很可能在其它支持路径中也有。有可能是用户自己写的，这样会导致冲突。


这种情况无法避免。你如果要加载的话，你可以在你的LSP中添加支持路径后，自己在LISP程序中加载，


例：


(addsupportpath         "..XXXX")


(if (findfile "acaddoc.lsp") (load "acaddoc.lsp"))


(add supportpath ".....")


...