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

孤独客 发表于 2005-3-3 22:40:00

tangjunasd58 发表于 2013-5-12 22:10:10

;;
(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 发表于 2005-3-5 14:30:00

转载自BDYCAD大侠的帖子.

<IMG alt=发贴心情 src="http://www.mjtd.com/bbs/skins/default/topicface/face1.gif" border=0> <B></B><BR>例如：

(setenv "ACAD" (strcat "D:\\Program Files\\BB;" (getenv "ACAD"))))

D:\\Program Files\\BB = 要加载的文件路径

如果有多个路径可加在分号后面,别忘了最后一个路径后要加分号.

onej 发表于 2005-3-7 11:49:00

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

tangjunasd58 发表于 2013-5-12 22:11:10

;;
(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 发表于 2013-5-12 22:13:23

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

xiaojiajun160 发表于 2021-10-31 17:14:06

谢谢大大！！我看看

页: [1]

明经CAD社区's Archiver

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