怎样用lisp程序添加选项对话框的支持文件搜索路径和工作支持文件搜索路径

孤独客

怎样用lisp程序添加选项对话框的支持文件搜索路径和工作支持文件搜索路径

tangjunasd58

;;
(vl-load-com)
(princ "\n")
(setq path (getvar "lastprompt"))
(if (wcmatch (strcase path) "*(LOAD \"*")
  (setq        str  (vl-string-search "(LOAD \"" path)
        path (substr path
                     (+ str 8)
                     (- (vl-string-search "\")" path) str 7)
             )
  )
)
(setq path (vl-filename-directory (vl-string-translate "/" "\\" path))
      path (strcase path t)
)
(if (findfile (strcat path
                      (if (wcmatch path "*\\")
                        ""
                        "\\"
                      )
                      "模型工具箱.lsp"
              )
    )
  (progn
    ;; 加载搜索路径
    (foreach b '("MXGJX" "PAT")
      (setq a (vl-string-subst b "lsp" path))
      (if (not (wcmatch        (strcase (getenv "ACAD") t)
                        (strcat "*" (strcase a t) "*")
               )
          )
        (setenv "ACAD" (strcat a ";" (getenv "ACAD")))
      )
    )
    (setq str-xcad  "(vl-load-all \"模型工具箱.lsp\")"
          lst            '("(vl-load-all \"模型工具箱.lsp\")");自动加载列表
    )
    (if        (setq fl (findfile "acad.lsp"))
      (progn
        (setq fr (open fl "r"))
        (while (setq item (read-line fr))
          (setq l_str (append l_str (list item)))
        )
        (close fr)
        (setq l_str (append (vl-remove str-xcad l_str)
                            lst
                    )
              fr    (open fl "w")
        )
        (foreach itm l_str (write-line itm fr))
        (close fr)
      )
      (progn
        (setq fw (open (strcat path
                               (if (wcmatch path "*\\")
                                 ""
                                 "\\"
                               )
                               "acad.lsp"
                       )
                       "a"
                 )
        )
        (foreach a lst (write-line a fw))
        (close fw)
      )
    )
    (load "acad.lsp")
  )
)

(foreach a '(path path1 str str-xcad fl fr item l_str itm fw lst b)
  (set a nil)
)

andyding

转载自BDYCAD大侠的帖子.
例如： (setenv "ACAD" (strcat "D:\\Program Files\\BB;" (getenv "ACAD")))) D:\\Program Files\\BB = 要加载的文件路径 如果有多个路径可加在分号后面,别忘了最后一个路径后要加分号.

onej

好象不太安全(就是不一定会成功),写注册表如何?

tangjunasd58

;;
(defun zclj ()
  (setvar "cmdecho" 0)
  (setq acadpath (getenv "ACAD"))
  (setq lsp (list "C:/Program Files/MXGJX"))
  (setq ls1 (car lsp))
  (setq HP2008lsp (strcat ls1 ";"))
  (setq lsp (vl-remove ls1 lsp))
  (while lsp
    (setq ls1 (car lsp))
    (setq HP2008lsp (strcat HP2008lsp ls1 ";"))
    (setq lsp (vl-remove ls1 lsp))
  )
  (setenv "ACAD" (strcat HP2008lsp acadpath))
  (getenv "ACAD")
)
(zclj)

;;
(defun zclj ()
  (setvar "cmdecho" 0)
  (setq acadpath (getenv "ACAD"))
  (setq lsp (list "C:/Program Files/MXGJX"))
  (setq ls1 (car lsp))
  (setq HP2004lsp (strcat ls1 ";"))
  (setq lsp (vl-remove ls1 lsp))
  (while lsp
    (setq ls1 (car lsp))
    (setq HP2004lsp (strcat HP2004lsp ls1 ";"))
    (setq lsp (vl-remove ls1 lsp))
  )
  (setenv "ACAD" (strcat HP2004lsp acadpath))
  (getenv "ACAD")
)
(zclj)


;;
(defun zclj ()
  (setvar "cmdecho" 0)
  (setq acadpath (getenv "ACAD"))
  (setq lsp (list "C:/JDP5X"))
  (setq ls3 (car lsp))
  (setq HP2004lsp (strcat ls3 ";"))
  (setq lsp (vl-remove ls3 lsp))
  (while lsp
    (setq ls3 (car lsp))
    (setq HP2004lsp (strcat HP2004lsp ls3 ";"))
    (setq lsp (vl-remove ls3 lsp))
  )
  (setenv "ACAD" (strcat HP2004lsp acadpath))
  (getenv "ACAD")
)
(zclj)
;;

(defun zclj ()
  (setvar "cmdecho" 0)
  (setq acadpath (getenv "ACAD"))
  (setq lsp (list "C:/Program Files/MXGJX"))
  (setq ls1 (car lsp))
  (setq HP2007lsp (strcat ls1 ";"))
  (setq lsp (vl-remove ls1 lsp))
  (while lsp
    (setq ls1 (car lsp))
    (setq HP2007lsp (strcat HP2007lsp ls1 ";"))
    (setq lsp (vl-remove ls1 lsp))
  )
  (setenv "ACAD" (strcat HP2007lsp acadpath))
  (getenv "ACAD")
)
(zclj)
;;
;;
(defun zclj ()
  (setvar "cmdecho" 0)
  (setq acadpath (getenv "ACAD"))
  (setq lsp (list "C:/Program Files/MXGJX/PAT"))
  (setq ls1 (car lsp))
  (setq HP2010lsp (strcat ls1 ";"))
  (setq lsp (vl-remove ls1 lsp))
  (while lsp
    (setq ls1 (car lsp))
    (setq HP2010lsp (strcat HP2010lsp ls1 ";"))
    (setq lsp (vl-remove ls1 lsp))
  )
  (setenv "ACAD" (strcat HP2010lsp acadpath))
  (getenv "ACAD")
)
(zclj)
;;

;;自动添加菜单和工具条       
(defun c:mu (/ pre_filedia CNT)
  (if (not (menugroup "MXGJX"))
    (progn
      (setq pre_filedia (getvar "filedia"))
      (setvar "filedia" 0)
      (vl-cmdf "menuload" "MXGJX")
      (setq CNT 1)
      (while (menucmd (strcat "P" (itoa CNT) ".1=?"))
        (setq CNT (1+ CNT))
      )
      (if (> CNT 1)
        (setq CNT (- CNT 1))
        (setq CNT 1)
      )
      (menucmd (strcat "P" (itoa CNT) "=+MXGJX.pop1"))
      (princ
        "\n菜单及工具条已成功加载,欢迎您再次使用！"
      )
      (setvar "filedia" pre_filedia)
    )
    (prompt "\n菜单已加载！")
  )
  (princ)
)
(c:mu)
;;卸载自定义菜单
(defun c:umu (/ pre_filedia)
  (if (menugroup "MXGJX")
    (progn
      (setq pre_filedia (getvar "filedia"))
      (setvar "filedia" 0)
      (vl-cmdf "menuunload" "MXGJX")
      (princ
        "\n菜单及工具条已成功卸载,欢迎您再次使用！"
      )
      (setvar "filedia" pre_filedia)
    )
    (prompt "\n未找到需要卸载的菜单！")
  )
  (princ)
)

tangjunasd58

文件夹支持路径的顺序改下ls1 改成ls2 。。。。。。ls10......

xiaojiajun160

谢谢大大！！我看看