一个工具箱的自动加载程序的设计的例子

marting

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

(defun InitCywApplication (/
                           ;; 内部函数
                           GetMyApplicationPath
                           GetCywPath               strParse
                           StrUnParse               Cyw_AddSupportPath
                           Load_CywMenu               Cyw_placemenu
                           ;; 局部变量
                           Cyw_cmdecho_save
                          )

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

  (defun GetCywPath ()
    (GetMyApplicationPath "cyw 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

;;; 添加支持文件搜索路径
;;; ---------------------------------------------------------------------------------
;;; note:  第二个参数如果为真, 插最前，否则插最后
;;;        
  (defun Cyw_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 ";"))
      )
    )
  )

  (defun Load_CywMenu (/ acadver)
    (setq acadver (atof (getvar "acadver")))
    (cond
      ((and (>= acadver 15.0) (< acadver 16.0))
       (command "_menuload" "Cyw.mns")
      )
      ((and (>= acadver 16.0) (<= acadver 16.1))
       (command "_menuload" "Cyw2004.mns")
      )
      ((>= acadver 16.2) (command "_menuload" "Cyw2006.mns"))
    )
  )


  ;; The following code "placemenu" from LUCAS(龙龙仔)
  (defun Cyw_placemenu (/ n)
    (if        (menugroup "Cyw")
      (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) "=+Cyw.pop1"))
              (setq n 25)
            )                                ;progn
          )                                ;if
        )                                ;while
      )                                        ;progn
    )                                        ;if
    (princ)
  )

;;; -----------------------------------------------------
;;; 主程序：
;;; -----------------------------------------------------
  (setq Cyw_cmdecho_save (getvar "cmdecho"))
  (setvar "cmdecho" 0)

  ;; 加载下拉菜单
  (Cyw_AddSupportPath (GetCywPath) nil)

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

  ;; 插到合适的位置
  (Cyw_placemenu)
  (setvar "cmdecho" Cyw_cmdecho_save)
  (setq Cyw_cmdecho_save nil)

  (princ)
) ;_end of defun initCywApplication

(initCywApplication)

;; 加载主程序
(if (findfile "mm.lsp")
  (load "mm.lsp")
)
(if (findfile "LSP_shzgb.LSP")
  (load "LSP_shzgb.LSP")
)
(if (findfile "initial.lsp")
  (load "initial.lsp")
)
(if (findfile "int_str.lsp")
  (load "int_str.lsp")
)
(if (findfile "ahobj.lsp")
  (load "ahobj.lsp")
)
(if (findfile "FASTZOOM.LSP")
  (LOAD "FASTZOOM.LSP")
)
(if (findfile "puu.lsp")
  (load "puu.lsp")
)
(if (findfile "chgt.lsp")
  (load "chgt.lsp")
)
(if (findfile "ddchprop")
  (load "ddchprop")
)
(if (findfile "wbbj.VLX")
  (load "wbbj.VLX")
)
(if (findfile "y.VLX")
  (load "y.VLX")
)
(if (findfile "ddmodify.VLX")
  (load "ddmodify.VLX")
)
(if (findfile "BatchPlot.lsp")
  (load "BatchPlot.lsp")
)
(if (findfile "FASTZOOM.LSP")
  (LOAD "FASTZOOM.LSP")
)
(if (findfile "pjgb.arx")
  (arxLOAD "pjgb.arx")
)
(if (findfile "chtext.LSP")
  (LOAD "chtext.LSP")
)
(if (findfile "ff.LSP")
  (LOAD "ff.LSP")
)
(if (findfile "ali1.LSP")
  (LOAD "ali1.LSP")
)
(if (findfile "chtext.LSP")
  (LOAD "chtext.LSP")
)
(if (findfile "qzfl.lsp")
  (LOAD "qzfl.lsp")
)
(if (findfile "jss.vlx")
  (LOAD "jss.vlx")
)
(if (findfile "wbdq.vlx")
  (LOAD "wbdq.vlx")
)
(if (findfile "zhuang.lsp")
  (LOAD "zhuang.lsp")
)
(if (findfile "gbj.vlx")
  (LOAD "gbj.vlx")
)
(if (findfile "miban.vlx")
  (LOAD "miban.vlx")
)
(princ)

st788796

用 Inno Setup 制作的安装程序可以直接把 Support 路径写入注册表，对全部 alisp 程序，加上 acad.lsp 或者 acaddocxxx.lsp 就可以自动加载了

yjch

啥也不说了，感谢楼主分享！有收获

zhangq_cai1

正需要，支持楼主大人了！

cq_qg68

太有用了，感谢！

zhang119

太需要了，，，，，，，，，，，，，，，，，

wofatfat19777

正需要，支持楼主大人了！