求助]：请大家帮我看一下我的安装程序lisp问题出在哪里？

chinasbc · 发表于 2005-11-26 21:17:09

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

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

×

我根据秋枫兄创作的CAD二次通用安装制作程序制作了安装包，但程序运行后，既没有菜单加入，也没有支持路径加入。刚学lisp，请各位帮忙看一下问题出在哪里？谢谢。

;;; 判断是否加载本文件
(if (car (atoms-family 1 '("vl-load-com")))
 (vl-load-com)
 ;;else
 (progn
(Alert
 "阿炳设计助手提示您：非常抱歉，这个程序集是为AutoCAD 2000以及更高的版本设计的，许多程序有可能在AutoCAD R14上不能正确地运行，建议您升级至2000以上版本。"
)
(exit) ; 版本不符，退出加载。
;; 首先定义初始化函数
(defun InitarbingApplication (/
 ;; 内部函数
 GetMyApplicationPath GetarbingPath
 strParse StrUnParse
 arbing_AddSupportPath Load_arbingMenu
 arbing_placemenu
 ;; 局部变量
 arbing_cmdecho_save
 )

;;; 取得本程序的路径.
;;; 文件路径从注册表中读取，这些信息由安装程序负责写入注册表
;;; ---------------------------------------------------------------------------------
 (defun GetMyApplicationPath (AppID)
(vl-registry-read
 (strcat
 "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\"
 AppID
 "_is1"
 )
 "Inno Setup: App Path"
)
 )

;; 这里取得安装后，安装的文件夹的绝对路径
;; 注意：这里的AppID为"阿炳设计助手", 稍后的安装程序制作向导设置中必须与这里保持一致
 (defun GetarbingPath ()
(GetMyApplicationPath "阿炳设计助手")
 )

;;; 解析字符串为表（函数来自明经通道转载）
;;; ---------------------------------------------------------------------------------
 (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

;;; 添加支持文件搜索路径
;;; ---------------------------------------------------------------------------------
;;; note: 第二个参数如果为真, 插最前，否则插最后
;;;
 (defun arbing_AddSupportPath (PathToAdd isFirst / supportlist)
(if (not
 (vl-string-search
 (strcase (strcat pathToAdd ";"))
 (strcase (strcat (getenv "ACAD") ";"))
 )
 ) ; 保证不重复添加
 (progn
 (setq supportlist (strparse (getenv "ACAD") ";"))
 (setq supportlist
 (vl-remove-if-not
 'vl-file-directory-p
 supportlist
 )
 ) ; 移除不存在的文件夹
 (if isFirst
 (setq supportlist (cons PathToAdd supportlist))
 (setq supportlist (append supportlist (list PathToAdd)))
 )
 (setenv "ACAD" (strUnParse supportlist ";"))
 )
)
 )
;;; 初始化主函数
;;; ---------------------------------------------------
;;; 添加支持路径
 (arbing_AddSupportPath (GetarbingPath) nil)
 (arbing_AddSupportPath (strcat (GetarbingPath) "\\lsp") nil)
 (arbing_AddSupportPath (strcat (GetarbingPath) "\\ada") nil)
 (arbing_AddSupportPath (strcat (GetarbingPath) "\\lib") nil)

 ;; 根据不同的AutoCAD版本加载不同的菜单文件。
 (defun Load_arbingMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
 ((and (>= acadver 15.0) (< acadver 16.0))
 (command "_menuload" "arbing.mns")
 )
 ((and (>= acadver 16.0) (<= acadver 16.1))
 (command "_menuload" "arbing2004.mns")
 )
 ((>= acadver 16.2) (command "_menuload" "arbing2006.mns"))
)
 )

 ;; 这个函数用来插入菜单条
 ;; The following code "placemenu" from LUCAS(龙龙仔)
 (defun arbing_placemenu (/ n)
(if (menugroup "arbing")
 (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
 ;; 如需插入多条菜单，以反序在这里写：
 ;; 因只有一条下拉菜单，因此这里4，3条注释掉
 ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop4"))
 ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop3"))
 ;;(menucmd (strcat "p" (itoa n) "=+arbing.pop2"))
 (menucmd (strcat "p" (itoa n) "=+arbing.pop1"))
 (setq n 25)
 ) ;progn
 ) ;if
 ) ;while
 ) ;progn
) ;if
(princ)
 )

;;; -----------------------------------------------------
;;; main：
;;; -----------------------------------------------------
 (setq arbing_cmdecho_save (getvar "cmdecho"))
 (setvar "cmdecho" 0)

 ;; 加载下拉菜单
 (arbing_AddSupportPath (GetarbingPath) nil)

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

 ;; 插到合适的位置
 (arbing_placemenu)
 (setvar "cmdecho" arbing_cmdecho_save)
 (setq arbing_cmdecho_save nil)

 (princ)
) ;_end of defun initarbingApplication

(initarbingApplication)

;; 加载主程序
;; 为节省内存，这里也可以以autoload函数形式定义
;; 有几条写几条
(load "arbing.vlx")

(princ)

xyp1964 · 发表于 2005-11-26 21:28:54

随便看了看

[FONT=courier new]
;;; 判断是否加载本文件
(if (car (atoms-family 1 '("vl-load-com")))
(vl-load-com)
(progn
(Alert
"阿炳设计助手提示您：非常抱歉，这个程序集是为AutoCAD 2000以及更高的版本设计的，
许多程序有可能在AutoCAD R14上不能正确地运行，建议您升级至2000以上版本。"
)
(exit) ; 版本不符，退出加载。
)
)
;; 首先定义初始化函数
(defun InitarbingApplication (/
GetMyApplicationPath
GetarbingPath
strParse
StrUnParse
arbing_AddSupportPath
Load_arbingMenu
arbing_placemenu
arbing_cmdecho_save
)
;;; 取得本程序的路径.
;;; 文件路径从注册表中读取，这些信息由安装程序负责写入注册表
;;; ---------------------------------------------------------------------------------
(defun GetMyApplicationPath (AppID)
(vl-registry-read
(strcat
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"
AppID
"_is1"
)
"Inno Setup: App Path"
)
)
;; 这里取得安装后，安装的文件夹的绝对路径
;; 注意：这里的AppID为"阿炳设计助手", 稍后的安装程序制作向导设置中必须与这里保持一致
(defun GetarbingPath ()
(GetMyApplicationPath "阿炳设计助手")
)
;;; 解析字符串为表（函数来自明经通道转载）
;;; ---------------------------------------------------------------------------------
(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
;;; 添加支持文件搜索路径
;;; ---------------------------------------------------------------------------------
;;; note: 第二个参数如果为真, 插最前，否则插最后
;;;
(defun arbing_AddSupportPath (PathToAdd isFirst / supportlist)
(if (not
(vl-string-search
(strcase (strcat pathToAdd ";"))
(strcase (strcat (getenv "ACAD") ";"))
)
) ; 保证不重复添加
(progn
(setq supportlist (strparse (getenv "ACAD") ";"))
(setq supportlist
(vl-remove-if-not
'vl-file-directory-p
supportlist
)
) ; 移除不存在的文件夹
(if isFirst
(setq supportlist (cons PathToAdd supportlist))
(setq supportlist (append supportlist (list PathToAdd)))
)
(setenv "ACAD" (strUnParse supportlist ";"))
)
)
)
;;; 初始化主函数
;;; ---------------------------------------------------
;;; 添加支持路径
(arbing_AddSupportPath (GetarbingPath) nil)
(arbing_AddSupportPath (strcat (GetarbingPath) "\\lsp") nil)
(arbing_AddSupportPath (strcat (GetarbingPath) "\\ada") nil)
(arbing_AddSupportPath (strcat (GetarbingPath) "\\lib") nil)
;; 根据不同的AutoCAD版本加载不同的菜单文件。
(defun Load_arbingMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acadver 16.0))
(command "_menuload" "arbing.mns")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "arbing2004.mns")
)
((>= acadver 16.2) (command "_menuload" "arbing2006.mns"))
)
)
;; 这个函数用来插入菜单条
;; The following code "placemenu" from LUCAS(龙龙仔)
(defun arbing_placemenu (/ n)
(if (menugroup "arbing")
(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
;; 如需插入多条菜单，以反序在这里写：
;; 因只有一条下拉菜单，因此这里4，3条注释掉
;; (menucmd (strcat "p" (itoa n) "=+arbing.pop4"))
;; (menucmd (strcat "p" (itoa n) "=+arbing.pop3"))
;;(menucmd (strcat "p" (itoa n) "=+arbing.pop2"))
(menucmd (strcat "p" (itoa n) "=+arbing.pop1"))
(setq n 25)
) ;progn
) ;if
) ;while
) ;progn
) ;if
(princ)
)
;;; -----------------------------------------------------
;;; main：
;;; -----------------------------------------------------
(setq arbing_cmdecho_save (getvar "cmdecho"))
(setvar "cmdecho" 0)
;; 加载下拉菜单
(arbing_AddSupportPath (GetarbingPath) nil)
;; 如果菜单组还没有被加载，则加载之
(if (not (menugroup "arbing"))
(Load_arbingMenu)
)
;; 插到合适的位置
(arbing_placemenu)
(setvar "cmdecho" arbing_cmdecho_save)
(setq arbing_cmdecho_save nil)
(princ)
) ;_end of defun initarbingApplication
(initarbingApplication)
;; 加载主程序
;; 为节省内存，这里也可以以autoload函数形式定义
;; 有几条写几条
(load "arbing.vlx")
(princ)[/FONT]

[FONT=courier new] 
;;; 判断是否加载本文件 
(if (car (atoms-family 1 '("vl-load-com"))) 
  (vl-load-com) 
  (progn 
    (Alert 
      "阿炳设计助手提示您：非常抱歉，这个程序集是为AutoCAD 2000以及更高的版本设计的， 
许多程序有可能在AutoCAD R14上不能正确地运行，建议您升级至2000以上版本。" 
    ) 
    (exit)                                ; 版本不符，退出加载。 
  ) 
) 
 
 
;; 首先定义初始化函数 
(defun InitarbingApplication (/ 
                              GetMyApplicationPath 
                              GetarbingPath 
                              strParse 
                              StrUnParse 
                              arbing_AddSupportPath 
                              Load_arbingMenu 
                              arbing_placemenu 
                              arbing_cmdecho_save 
                             ) 
 
;;; 取得本程序的路径. 
;;; 文件路径从注册表中读取，这些信息由安装程序负责写入注册表 
;;; --------------------------------------------------------------------------------- 
  (defun GetMyApplicationPath (AppID) 
    (vl-registry-read 
      (strcat 
        "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\" 
        AppID 
        "_is1" 
      ) 
      "Inno Setup: App Path" 
    ) 
  ) 
 
  ;; 这里取得安装后，安装的文件夹的绝对路径 
  ;; 注意：这里的AppID为"阿炳设计助手", 稍后的安装程序制作向导设置中必须与这里保持一致 
  (defun GetarbingPath () 
    (GetMyApplicationPath "阿炳设计助手") 
  ) 
 
;;; 解析字符串为表（函数来自明经通道转载） 
;;; --------------------------------------------------------------------------------- 
  (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 
 
;;; 添加支持文件搜索路径 
;;; --------------------------------------------------------------------------------- 
;;; note: 第二个参数如果为真, 插最前，否则插最后 
;;; 
  (defun arbing_AddSupportPath (PathToAdd isFirst / supportlist) 
    (if        (not 
          (vl-string-search 
            (strcase (strcat pathToAdd ";")) 
            (strcase (strcat (getenv "ACAD") ";")) 
          ) 
        )                                ; 保证不重复添加 
      (progn 
        (setq supportlist (strparse (getenv "ACAD") ";")) 
        (setq supportlist 
               (vl-remove-if-not 
                 'vl-file-directory-p 
                 supportlist 
               ) 
        )                                ; 移除不存在的文件夹 
        (if isFirst 
          (setq supportlist (cons PathToAdd supportlist)) 
          (setq supportlist (append supportlist (list PathToAdd))) 
        ) 
        (setenv "ACAD" (strUnParse supportlist ";")) 
      ) 
    ) 
  ) 
;;; 初始化主函数 
;;; --------------------------------------------------- 
;;; 添加支持路径 
  (arbing_AddSupportPath (GetarbingPath) nil) 
  (arbing_AddSupportPath (strcat (GetarbingPath) "\\lsp") nil) 
  (arbing_AddSupportPath (strcat (GetarbingPath) "\\ada") nil) 
  (arbing_AddSupportPath (strcat (GetarbingPath) "\\lib") nil) 
 
 
  ;; 根据不同的AutoCAD版本加载不同的菜单文件。 
  (defun Load_arbingMenu (/ acadver) 
    (setq acadver (atof (getvar "acadver"))) 
    (cond 
      ((and (>= acadver 15.0) (< acadver 16.0)) 
       (command "_menuload" "arbing.mns") 
      ) 
      ((and (>= acadver 16.0) (<= acadver 16.1)) 
       (command "_menuload" "arbing2004.mns") 
      ) 
      ((>= acadver 16.2) (command "_menuload" "arbing2006.mns")) 
    ) 
  ) 
 
  ;; 这个函数用来插入菜单条 
  ;; The following code "placemenu" from LUCAS(龙龙仔) 
  (defun arbing_placemenu (/ n) 
    (if        (menugroup "arbing") 
      (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 
              ;; 如需插入多条菜单，以反序在这里写： 
              ;; 因只有一条下拉菜单，因此这里4，3条注释掉 
              ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop4")) 
              ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop3")) 
              ;;(menucmd (strcat "p" (itoa n) "=+arbing.pop2")) 
              (menucmd (strcat "p" (itoa n) "=+arbing.pop1")) 
              (setq n 25) 
            )                                ;progn 
          )                                ;if 
        )                                ;while 
      )                                        ;progn 
    )                                        ;if 
    (princ) 
  ) 
 
;;; ----------------------------------------------------- 
;;; main： 
;;; ----------------------------------------------------- 
  (setq arbing_cmdecho_save (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
 
  ;; 加载下拉菜单 
  (arbing_AddSupportPath (GetarbingPath) nil) 
 
  ;; 如果菜单组还没有被加载，则加载之 
  (if (not (menugroup "arbing")) 
    (Load_arbingMenu) 
  ) 
 
  ;; 插到合适的位置 
  (arbing_placemenu) 
  (setvar "cmdecho" arbing_cmdecho_save) 
  (setq arbing_cmdecho_save nil) 
 
  (princ) 
) ;_end of defun initarbingApplication 
 
(initarbingApplication) 
 
;; 加载主程序 
;; 为节省内存，这里也可以以autoload函数形式定义 
;; 有几条写几条 
(load "arbing.vlx") 
(princ)[/FONT]

chinasbc · 发表于 2005-11-28 09:18:55

谢谢版主。上次的程序是结构混乱，括号不完整。
这次我修改后，不知为什么菜单总加不上，支持路径倒加上了（不过在最后，如何把路径移到其它路径之后CAD路径之前?看程序应该是在cad路径之前呀？），进入后，在加载应用程序内手工加载一遍就ok了。这次不知问题出在哪里。谢谢版主。

;;; 判断是否加载本文件
(if (car (atoms-family 1 '("vl-load-com")))
(vl-load-com)
(progn
(Alert
"阿炳设计助手提示您：非常抱歉，这个程序集是为AutoCAD 2000以及更高的版本设计的，许多程序有可能在AutoCAD R14上不能正确地运行，建议您升级至2000以上版本。"
)
(exit) ; 版本不符，退出加载。
)
)
;; 首先定义初始化函数
(defun InitarbingApplication (/
GetMyApplicationPath
GetarbingPath
strParse
StrUnParse
arbing_AddSupportPath
Load_arbingMenu
arbing_placemenu
arbing_cmdecho_save
)
;;; 取得本程序的路径.
;;; 文件路径从注册表中读取，这些信息由安装程序负责写入注册表
;;; ---------------------------------------------------------------------------------
(defun GetMyApplicationPath (AppID)
(vl-registry-read
(strcat
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"
AppID
"_is1"
)
"Inno Setup: App Path"
)
)
;; 这里取得安装后，安装的文件夹的绝对路径
;; 注意：这里的AppID为"阿炳设计助手", 稍后的安装程序制作向导设置中必须与这里保持一致
(defun GetarbingPath ()
(GetMyApplicationPath "阿炳设计助手")
)
;;; 解析字符串为表（函数来自明经通道转载）
;;; ---------------------------------------------------------------------------------
(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
;;; 添加支持文件搜索路径
;;; ---------------------------------------------------------------------------------
;;; note: 第二个参数如果为真, 插最前，否则插最后
;;;
(defun arbing_AddSupportPath (PathToAdd isFirst / supportlist)
(if (not
(vl-string-search
(strcase (strcat pathToAdd ";"))
(strcase (strcat (getenv "ACAD") ";"))
)
) ; 保证不重复添加
(progn
(setq supportlist (strparse (getenv "ACAD") ";"))
(setq supportlist
(vl-remove-if-not
'vl-file-directory-p
supportlist
)
) ; 移除不存在的文件夹
(if isFirst
(setq supportlist (cons PathToAdd supportlist))
(setq supportlist (append supportlist (list PathToAdd)))
)
(setenv "ACAD" (strUnParse supportlist ";"))
)
)
)
;;; 初始化主函数
;;; ---------------------------------------------------
;;; 添加支持路径
(arbing_AddSupportPath (GetarbingPath) nil)
(arbing_AddSupportPath (strcat (GetarbingPath) "\\ada") nil)
;; 根据不同的AutoCAD版本加载不同的菜单文件。
(defun Load_arbingMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acadver 16.0))
(command "_menuload" "arbing.mns")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "arbing2004.mns")
)
((>= acadver 16.2) (command "_menuload" "arbing2006.mns"))
)
)
;; 这个函数用来插入菜单条
;; The following code "placemenu" from LUCAS(龙龙仔)
(defun arbing_placemenu (/ n)
(if (menugroup "arbing")
(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
;; 如需插入多条菜单，以反序在这里写：
;; 因只有一条下拉菜单，因此这里4，3条注释掉
;; (menucmd (strcat "p" (itoa n) "=+arbing.pop4"))
;; (menucmd (strcat "p" (itoa n) "=+arbing.pop3"))
;;(menucmd (strcat "p" (itoa n) "=+arbing.pop2"))
(menucmd (strcat "p" (itoa n) "=+arbing.pop1"))
(setq n 25)
) ;progn
) ;if
) ;while
) ;progn
) ;if
(princ)
)
;;; -----------------------------------------------------
;;; 主程序：
;;; -----------------------------------------------------
(princ "\n采撷众家之开发精髓，打造精品之设计助手！\n欢迎使用阿炳设计助手。正在加载，请稍候。")
(setq arbing_cmdecho_save (getvar "cmdecho"))
(setvar "cmdecho" 0)
;; 加载下拉菜单
(arbing_AddSupportPath (GetarbingPath) nil)
;; 如果菜单组还没有被加载，则加载之
(if (not (menugroup "arbing"))
(Load_arbingMenu)
)
;; 插到合适的位置
(arbing_placemenu)
(setvar "cmdecho" arbing_cmdecho_save)
(setq arbing_cmdecho_save nil)
(princ)
) ;_end of defun initarbingApplication
(initarbingApplication)
;; 加载主程序
;; 为节省内存，这里也可以以autoload函数形式定义
;; 有几条写几条
(load "arbing.vlx")
(princ "\n阿炳设计助手加载完毕。版本 2005.12")
(princ "\n阿炳设计助手联系邮箱：SBCSL@163.com。网址：[url]http://arbing.wy8.net[/url]")

;;; 判断是否加载本文件 
(if (car (atoms-family 1 '("vl-load-com"))) 
  (vl-load-com) 
  (progn 
    (Alert 
      "阿炳设计助手提示您：非常抱歉，这个程序集是为AutoCAD 2000以及更高的版本设计的，许多程序有可能在AutoCAD R14上不能正确地运行，建议您升级至2000以上版本。" 
    ) 
    (exit)                                ; 版本不符，退出加载。 
  ) 
) 
 
 
;; 首先定义初始化函数 
(defun InitarbingApplication (/ 
                              GetMyApplicationPath 
                              GetarbingPath 
                              strParse 
                              StrUnParse 
                              arbing_AddSupportPath 
                              Load_arbingMenu 
                              arbing_placemenu 
                              arbing_cmdecho_save 
                             ) 
 
;;; 取得本程序的路径. 
;;; 文件路径从注册表中读取，这些信息由安装程序负责写入注册表 
;;; --------------------------------------------------------------------------------- 
  (defun GetMyApplicationPath (AppID) 
    (vl-registry-read 
      (strcat 
        "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\" 
        AppID 
        "_is1" 
      ) 
      "Inno Setup: App Path" 
    ) 
  ) 
 
  ;; 这里取得安装后，安装的文件夹的绝对路径 
  ;; 注意：这里的AppID为"阿炳设计助手", 稍后的安装程序制作向导设置中必须与这里保持一致 
  (defun GetarbingPath () 
    (GetMyApplicationPath "阿炳设计助手") 
  ) 
 
;;; 解析字符串为表（函数来自明经通道转载） 
;;; --------------------------------------------------------------------------------- 
  (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 
 
;;; 添加支持文件搜索路径 
;;; --------------------------------------------------------------------------------- 
;;; note: 第二个参数如果为真, 插最前，否则插最后 
;;; 
  (defun arbing_AddSupportPath (PathToAdd isFirst / supportlist) 
    (if        (not 
          (vl-string-search 
            (strcase (strcat pathToAdd ";")) 
            (strcase (strcat (getenv "ACAD") ";")) 
          ) 
        )                                ; 保证不重复添加 
      (progn 
        (setq supportlist (strparse (getenv "ACAD") ";")) 
        (setq supportlist 
               (vl-remove-if-not 
                 'vl-file-directory-p 
                 supportlist 
               ) 
        )                                ; 移除不存在的文件夹 
        (if isFirst 
          (setq supportlist (cons PathToAdd supportlist)) 
          (setq supportlist (append supportlist (list PathToAdd))) 
        ) 
        (setenv "ACAD" (strUnParse supportlist ";")) 
      ) 
    ) 
  ) 
;;; 初始化主函数 
;;; --------------------------------------------------- 
;;; 添加支持路径 
  (arbing_AddSupportPath (GetarbingPath) nil) 
  (arbing_AddSupportPath (strcat (GetarbingPath) "\\ada") nil) 
   
 
  ;; 根据不同的AutoCAD版本加载不同的菜单文件。 
  (defun Load_arbingMenu (/ acadver) 
    (setq acadver (atof (getvar "acadver"))) 
    (cond 
      ((and (>= acadver 15.0) (< acadver 16.0)) 
       (command "_menuload" "arbing.mns") 
      ) 
      ((and (>= acadver 16.0) (<= acadver 16.1)) 
       (command "_menuload" "arbing2004.mns") 
      ) 
      ((>= acadver 16.2) (command "_menuload" "arbing2006.mns")) 
    ) 
  ) 
 
  ;; 这个函数用来插入菜单条 
  ;; The following code "placemenu" from LUCAS(龙龙仔) 
  (defun arbing_placemenu (/ n) 
    (if        (menugroup "arbing") 
      (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 
              ;; 如需插入多条菜单，以反序在这里写： 
              ;; 因只有一条下拉菜单，因此这里4，3条注释掉 
              ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop4")) 
              ;; (menucmd (strcat "p" (itoa n) "=+arbing.pop3")) 
              ;;(menucmd (strcat "p" (itoa n) "=+arbing.pop2")) 
              (menucmd (strcat "p" (itoa n) "=+arbing.pop1")) 
              (setq n 25) 
            )                                ;progn 
          )                                ;if 
        )                                ;while 
      )                                        ;progn 
    )                                        ;if 
    (princ) 
  ) 
 
;;; ----------------------------------------------------- 
;;; 主程序： 
;;; ----------------------------------------------------- 
  (princ "\n采撷众家之开发精髓，打造精品之设计助手！\n欢迎使用阿炳设计助手。正在加载，请稍候。") 
  (setq arbing_cmdecho_save (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
 
  ;; 加载下拉菜单 
  (arbing_AddSupportPath (GetarbingPath) nil) 
 
  ;; 如果菜单组还没有被加载，则加载之 
  (if (not (menugroup "arbing")) 
    (Load_arbingMenu) 
  ) 
 
  ;; 插到合适的位置 
  (arbing_placemenu) 
  (setvar "cmdecho" arbing_cmdecho_save) 
  (setq arbing_cmdecho_save nil) 
 
  (princ) 
) ;_end of defun initarbingApplication 
 
(initarbingApplication) 
 
;; 加载主程序 
;; 为节省内存，这里也可以以autoload函数形式定义 
;; 有几条写几条 
(load "arbing.vlx") 
(princ "\n阿炳设计助手加载完毕。版本 2005.12") 
(princ "\n阿炳设计助手联系邮箱：SBCSL@163.com。网址：[url]http://arbing.wy8.net[/url]")

netbee · 发表于 2005-11-28 09:40:28

需要将此文件更名为和菜单文件一样的名称，扩展名为MNL
如你的菜单为:ab.mnu
则此程序名为:ab.mnl

chinasbc · 发表于 2005-11-28 10:21:33

我这里面有3个菜单，分别对应于20004以下、2004、2006版本，当然菜单组名是一个，如ab.mmu,ab2004.mmu,ab2006.mmu，我该怎么更名？谢谢。

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

[求助] 求助]：请大家帮我看一下我的安装程序lisp问题出在哪里？

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

相关帖子