[原创]： AutoLISP程序的安装制教程（一）

秋枫 · 发表于 2005-4-10 12:53:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

AutoLISP程序的安装制教程（一） [ 日期：2005-04-10 ]

这篇教程演示如何使用本人制作的AutoLISP安装制作向导程序来制作简单的甚至单个文件的AutoLISP / Visual LISP应用程序。更加复杂的情况将另开专题讨论，这里先从简单的开始。

AutoCAD二次开发安装制作向导可以到此处下载（4月10日更新）：http://quelea.w3.zccn.net/blogview.asp?logID=42

这里以本人写的一个AutoCAD模型空间批量打印程序为例，演示如何为其制作安装程序。原程序是用Visual LISP写的，编译成了VLX文件，把对话框之类的也编译进去了，所以最后只有一个文件了。另有一个帮助文档，再加一个用于显示在安装程序中的授权协议。文件准备好了，如图所示：

登录/注册后可看大图

好，下面运行安装制作向导：

登录/注册后可看大图

指定基本的信息：

登录/注册后可看大图

设置安装ID。尽可能使其具有唯一性。我设成Modelspace Bathplot，用中文也可以。
象微软的做法就是用这种如{40A91A5D-B133-4504-8942-77FA39B949A8}随机的CSID。
不过一旦确定了这个ID，在以后的升级、修补中都应保持这个ID相同。除非你希望两个版本共存在目标系统中。

登录/注册后可看大图

下面告诉安程序我的这个Blotplot支持AutoCAD的哪些版本。注意：这个安装程序不支R14。所以，最低的版本也要求是R15.0。当前AutoCAD的版本号可以从注册表中查到。我列举一些常用的：
AutoCAD 2000/2000i/2002: R15.0
AutoCAD 2004: R16.0
AutoCAD 2005: R16.1
AutoCAD 2006: R16.2

登录/注册后可看大图

指定我的程序文件夹。第一步就准备好了。

登录/注册后可看大图

设置AutoCAD启动时自动加载的文件。反正只有一个，就它了。

登录/注册后可看大图

我希望默认装Windows的系统盘下面的\Program Files\Batchplot for AutoCAD

登录/注册后可看大图

开始菜单设置：

登录/注册后可看大图

授权协议，嘿嘿，我也准备好了：

登录/注册后可看大图

信息文件，没准备。不要了，跳过：

登录/注册后可看大图

帮助文件，有的：

登录/注册后可看大图

图片我也没专门做，就用默认的图片好了：

登录/注册后可看大图

好了，都设好了。告诉向导安装程序生成后放在桌面上的“发布”文件夹中。

登录/注册后可看大图

OK。点下一步，大功告成：

登录/注册后可看大图

至此，我的安装程序做好了。
好了，运行一下安装程序试试看。

登录/注册后可看大图

事实上，最后生成的这个安装包是一个7z自解压文件。你如果喜欢更多的控制，不喜欢用向导来设置，完全可以解开这个压缩包，自己手动修改setup.ini控制文件。压缩包中的setup.exe就是我新做的LISPSetup啦。为了更稳定、更方便地定制，更主要是因为AutoCAD2006的菜单变化了，这个程序不再帮你加载菜单。实现加载菜单可以在启动时加载的程序中自主写代码。

登录/注册后可看大图

好了，这个简单的教程结束了。
更加复杂的，比如添加支持路径，添加菜单的安装定制，我将抽空另开专题。

相关：AutoCAD二次开发安装制作向导可以到此处下载（4月10日更新）：http://quelea.w3.zccn.net/blogview.asp?logID=42

全文完。
阅读全文及评论可至此处：http://quelea.w3.zccn.net/blogview.asp?logID=43

FLOODITIDE · 发表于 2005-4-10 21:53:38

提一个初级问题

你是怎样让autocad启动加载应用程序的

狂刀 · 发表于 2005-4-10 22:33:07

秋枫兄的新作,支持一下.

FLOODITIDE · 发表于 2005-4-10 22:44:55

而且，你说生成的文件是个压缩包，我的winrar3.2怎么不认得

它山之石 · 发表于 2005-4-11 12:26:16

俺正要制做一个结构工具箱，万事俱备，只欠秋枫。
现在可以了

金爵士 · 发表于 2005-4-11 13:12:28

崇拜的五体投地,伟大和渺小就在一线间,我可以把我的板金展开程序生成安装程序了,方便了大家,你我他,顶顶顶,狂顶!支持鼓励为大家服务的无私精神!1-2天内上传我的新安装程序!呵呵!

秋枫 · 发表于 2005-4-11 20:15:39

最初由 FLOODITIDE 发布
[B]而且，你说生成的文件是个压缩包，我的winrar3.2怎么不认得 [/B]

改用WinRAR 3.4即可，它是一个7z压缩包，低版本的RAR不支持这种格式。或者使用7-zip解开。

我这里采用7-zip是因为它是免费软件。

秋枫 · 发表于 2005-4-11 21:14:49

最初由 FLOODITIDE 发布
[B]提一个初级问题

你是怎样让autocad启动加载应用程序的 [/B]

是利用Appload.arx的启动组

秋枫 · 发表于 2005-4-11 21:18:18

发现这里的Code段不自动换行。
此文最初发表在Quelea Home，阅读困难可至此链接阅读
http://quelea.w3.zccn.net/blogview.asp?logID=44

接昨天的教程。今天来谈谈一些高级的话题，这些主要涉及到AutoLISP或Visual LISP的编程问题了。即如何解决向AutoCAD添加支持路径，添加菜单了。我只能说我提供一种解决方法，一种解决思路。其实这个与我做的这个安装程序制作向导本身的关系不是很大了。使用LISP方式解决的好处是：您可以最大限度地控制你的程序，按照你本人的意愿运行。

这里以我写的一个稍复杂一点的工具箱（QTools for AutoCAD）作为例子，在这个例子中，我需要添加AutoCAD支持路径，需要在启动时添加工具箱用的菜单条。

准备好文件夹，如图所示：

登录/注册后可看大图

在这个文件夹中，可以看到有三个菜单文件，对应不同的AutoCAD版本。另有一个需要AutoCAD启动时加载的LISP程序：LoadQTools.lsp

好了，先常规设置，基本的设置我就不详述了，可以参见[教程（一）]。我们这里设置AppID为QTools for AutoCAD。如图：

登录/注册后可看大图

指定程序文件夹与启动时要加载的文件：

登录/注册后可看大图

我们主要的工作都是在LoadQTools.lsp这个LISP程序中完成的。当然，你也可以选择ARX，VBA。它们都有能力完成这个LISP程序完成的工作。具体如何着手写你完全可以发挥你的创造性。我这里提供一个LISP的解决方案。就LISP这种方式来说，也有很多不同的解决方案，这里的思路仅供参考。

我们来分析一下LoadQTools.lsp的代码。

首先，在这个程序判断是不是AutoCAD 2000以上的版本，如果是R14，拒绝加载，退出。

;;; 判断是否加载本文件
(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 GetQToolsPath ()
(GetMyApplicationPath "QTools 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 ";"))
)
;;; 根据不同的AutoCAD版本加载不同的菜单文件：
(defun Load_QToolsMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acadver 16.0))
(command "_menuload" "QTools.mnu")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "QTools2004.mnu")
)
((>= acadver 16.2) (command "_menuload" "QTools2006.mnu"))
)
)
;;; The following code "placemenu" written by LUCAS
;;; 插入菜单条 Placemenu由LUCAS编写
;;; ---------------------------------------------------------------------------------
(defun QTools_PlaceMenu (/ n)
(if (menugroup "QTools")
(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) "=+QTools.pop3"))
(menucmd (strcat "p" (itoa n) "=+QTools.pop2"))
(menucmd (strcat "p" (itoa n) "=+QTools.pop1"))
(setq n 25)
) ;progn
) ;if
) ;while
) ;progn
) ;if
(princ)
)

;;; 以下定义文件中用到的函数 
;;;---------------------------------------------------------------------------------- 
 
;;; 取得本程序的路径 
;;; --------------------------------------------------------------------------------- 
(defun GetMyApplicationPath (AppID) 
  (vl-registry-read 
    (strcat 
      "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\" 
      AppID 
      "_is1" 
    ) 
    "Inno Setup: App Path" 
  ) 
) 
 
(defun GetQToolsPath () 
  (GetMyApplicationPath "QTools 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_QToolsMenu (/ acadver) 
  (setq acadver (atof (getvar "acadver"))) 
  (cond 
    ((and (&gt;= acadver 15.0) (&lt; acadver 16.0)) 
     (command "_menuload" "QTools.mnu") 
    ) 
    ((and (&gt;= acadver 16.0) (&lt;= acadver 16.1)) 
     (command "_menuload" "QTools2004.mnu") 
    ) 
    ((&gt;= acadver 16.2) (command "_menuload" "QTools2006.mnu")) 
  ) 
) 
 
;;; The following code "placemenu" written by LUCAS 
;;; 插入菜单条 Placemenu由LUCAS编写 
;;; --------------------------------------------------------------------------------- 
(defun QTools_PlaceMenu        (/ n) 
  (if (menugroup "QTools") 
    (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) "=+QTools.pop3")) 
            (menucmd (strcat "p" (itoa n) "=+QTools.pop2")) 
            (menucmd (strcat "p" (itoa n) "=+QTools.pop1")) 
            (setq n 25) 
          )                                ;progn 
        )                                ;if 
      )                                        ;while 
    )                                        ;progn 
  )                                        ;if 
  (princ) 
)

好了，下面可以开始设计初始化工具箱的主程序了：

;;; 初始化主函数
;;; ---------------------------------------------------
(defun Init_QTools ()
;; 添加支持路径
(QF_AddSupportPath (GetQToolsPath) nil)
(QF_AddSupportPath (strcat (GetQToolsPath) "\\LISP") nil)
(QF_AddSupportPath (strcat (GetQToolsPath) "\\LIB") nil)
(QF_AddSupportPath (strcat (GetQToolsPath) "\\BIN") nil)
;; 如果菜单组还没有被加载，则加载之
(if (not (menugroup "QTools"))
(Load_QToolsMenu)
)
;; 安排菜单条的位置
(QTools_PlaceMenu)
(princ)
)
;;; 以上函数部分定义完毕

主程序定义完毕，可以逐条执行了：

;;; -----------------------------------------------------
;;; 主程序：
;;; -----------------------------------------------------
(princ "\n加载QTools工具集……")
(setq qtools_cmdecho_save (getvar "cmdecho"))
(setvar "cmdecho" 0)
;;; 执行初始化
(Init_QTools)
(setvar "cmdecho" qtools_cmdecho_save)
(setq qtools_cmdecho_save nil)
(princ "\nQTools工具集加载完毕。版本 2005.4")
(princ)
;; autoload
(autoload "CWCT" '("CHANGE-THICKNESS" "CHANGE-WIDTH"))
;; ……下略

上面的代码最后，开始定义按需加载的LISP程序了。关于Autoload函数我就不多解释了，可以参考AutoCAD的相关文档。Autoload这部分也可以定义在相应菜单文件的MNL文件中。这个MNL文件会在菜单加载时自动加载。

在AutoCAD2006中，菜单文件的格式发生了一点变化，它仍然支持MNU, MNS, MNC文件，但它的文档中称这几个格式在未来的AutoCAD版本中不再支持。新的菜单格式为CUI文件。上述代码中使用的仍然是MNU文件，在AutoCAD 2006中是可以运行的，但在将来的AutoCAD版本中，需要作一些改变。

至此，这个加载过程完毕。通过安装制作向导的包装，完全可以生成一个看上去比较专业的安装程序了。

(全文完)

相关链接：
● AutoLISP程序的安装制教程（一）
● AutoCAD二次开发程序的安装制作向导
● Inno Setup
● 7-zip

它山之石 · 发表于 2005-4-12 10:29:12

　　再次感谢斑主的教程。俺正在做个工具箱的安装。思路跟你讲的差不多。
　　只是有一个问题，俺觉得不必每次都初始化。应该在注册表中增加一个标记，在程序第一次运行时才进行初始化。
　　当然这样可能会带来另一个问题。有时用户安装其它程序时可能会改变支持路径的顺序，如果俺的支持路径不在最先的位置可能导致出错。所以俺写了个LISP程序。是判断支持路径的顺序。如是不正确就重新设定。其中也用到了解析字符串为表的函数。只是俺的函数名不同，相信高手都知道如何处理的。
　　希望能对大家有用。当然如果每个工具箱都这么强行将自己的支持路径置顶设置，还是会出问题的。
[php]

;|==========================================================
功能
判断指定文件夹是否在AutoCAD支持搜索路径中(或支持搜索路径的指定位置)
语法
(Glisp_IfAtSupportPath dir pos)
参数
指定文件夹  指定位置(从1开始)
样例
当带指定位置参数时：
(Glisp_IfAtSupportPath "c:\myFolder" 3)
如果正确则返回T，否则返回NIL
当不带指定位置参数时：
(Glisp_IfAtSupportPath "c:\myFolder" nil)
如果正确则返回指定位置(从1开始)，否则返回NIL

|;==========================================================

(defun Glisp_IfAtSupportPath (dir pos / path_pos return1 return)
  (if (not pos)
(progn
   (setq return1 1)
   (mapcar '(lambda (x)
   (if (/= (strcase x) (strcase dir))
   (setq return1 (+ return1 1))
   (setq return return1)
   ) ;_ 结束if
         ) ;_ 结束lambda
      (parse (getenv "ACAD") ";")
   ) ;_ 结束mapcar
) ;_ 结束progn
(progn
   (setq path_pos (nth (- pos 1) (parse (getenv "ACAD") ";")))
   (if (/= (strcase path_pos) (strcase dir))
(setq return nil)
(setq return T)
   ) ;_ 结束if
) ;_ 结束progn
  ) ;_ 结束if
  return
) ;_ 结束defun
[/php]

wkai · 发表于 2005-4-12 13:32:51

还有 AutoLISP程序的安装制教程（二）么？

秋枫 · 发表于 2005-4-12 19:28:33

最初由 wkai 发布
[B]还有 AutoLISP程序的安装制教程（二）么？ [/B]

二就是9楼的帖子了。

它山之石 · 发表于 2005-4-14 12:26:14

有几个小问题，还敢请教斑主。
1、如果俺还想往其它目录下写文件，如何操作？增加个FILES字段吗？
2、如果俺还想往注册表中写点东东，如何操作？增加个REGISTRY字段吗？
3、生成的SETUP文件不能添加也不能删除文件，俺怎么修改SETUP.INI。或者说俺解压修改后再压缩时如何再做到不能添加也不能删除文件？用7ZIP？
4、加在启动级组中的文件是否记录在注册表中？俺如何找到？

秋枫 · 发表于 2005-4-14 21:52:36

最初由它山之石发布
[B]
有几个小问题，还敢请教斑主。
1、如果俺还想往其它目录下写文件，如何操作？增加个FILES字段吗？
2、如果俺还想往注册表中写点东东，如何操作？增加个REGISTRY字段吗？
3、生成的SETUP文件不能添加也不能删除文件，俺怎么修改SETUP.INI。或者说俺解压修改后再压缩时如何再做到不能添加也不能删除文件？用7ZIP？
4、加在启动级组中的文件是否记录在注册表中？俺如何找到？[/B]

1, 往其它目录下写文件这个安装程序不支持。不支持FILES段。
2. 另外往注册表中写东东也不支持。不支持REGISTRY段。

因为这个安装程序目标就是做得尽量简单。它本身是用Inno Setup制作的。你说的这些功能都是专业的安装制作软件所具有的，如果我这个简单的LISP安装程序无法满足您的要求，你可以直接用Inno Setup或Wise, InstallShield之类的软件写脚本。如果做到你的要求那种程度，感觉就是用Inno Setup写一个Inno setup出来了。（巧合的是，Inno Setup就是一个用Pascal语言写的免费的Pascal编译器(Remobject pascal)）

另一个折衷的办法就是把你要做的这些操作放到你的启动LSP程序中做。可以参考vl-file-copy, vl-file-delete , vl-file-directory-p, vl-mkdir, vl-registry-delete, vl-registry-descendents, vl-registry-read, vl-registry-write等vl函数。

3. 你用WinRAR不能修改7z压缩包。因为WinRAR只能解压不能创建7z格式。使用7-zip也不能修改这个压缩包的原因是因为我使用了固实压缩格式以尽量减小文件体积，7z目前还不支持修改固实压缩包。

你可以用WinRAR重建一个自解压格式，加上一点自解压脚本（写在注释中），就可以实现一样的功能。具体可以参见其帮助文件。
WinRAR自解压脚本例子：

[FONT=courier new]
;下面的注释包含自解压脚本命令
Setup=setup.exe
TempMode
Silent=2
[/FONT]

复制代码

你也可以使用7-zip软件的命令行来创建我提供的那种形式的自解压包，其中文版的帮助文档中也有详细的说明，你甚至可以加入一些安装前的确认对话框。7z是免费软件。

这里我提供我的7z脚本，很简单，三行：

[FONT=courier new]
;!@Install@!UTF-8!
RunProgram="setup.exe"
;!@InstallEnd@!
[/FONT]

复制代码

4. 如果你只是想读取启动文件自身的全路径，那么从教程中的LSP代码中提供了读取安装路径的样例函数GetMyApplicationPath。你可以用同样的方法得到启动文件名的全路径：

[FONT=courier new]
(defun GetMyStartupFile (AppID)
(vl-registry-read
(strcat
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"
AppID
"_is1"
)
"Inno Setup CodeFile: AutoLoadLispFile"
)
)
[/FONT]

其它相关信息也都在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\你的APPID_is1\ 下面。

不过不要轻易修改这个键下面的信息。它们对卸载以及覆盖安装都有用。

amuamu · 发表于 2005-4-14 23:27:23

好帖，有文有图很详细。

账号		自动登录	找回密码
密码			立即注册

[原创]： AutoLISP程序的安装制教程（一）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

AutoLISP程序的安装制作（二）