高手帮忙看一下添加文件搜索路径的lsp
本帖最后由 shep2008 于 2011-6-7 16:08 编辑在网上找到一个添加路径到CAD文件搜索路径的lsp如图所示位置，不知道要添加到哪里，请高手指点一下，例如我要添加D:\autocad1和D:\autocad2两个路径，要怎么改下面的代码：
代码我话到二楼去了，放这里不会自动换行 回复 shep2008 的帖子
(defun Example_SupportPath ()
;;;这个范例返回
;;;SupportPath的当前设定值，接着改变它的值，最后恢复初始值
(VL-LOAD-COM)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(setq preferenceSel (vla-get-Preferences AcadObject))
(setq fileSel (vla-get-Files preferenceSel))
;;;取出当前的SupportPath值
(setq currSupportPath (vla-get-SupportPath fileSel))
(princ "SupportPath的值当前设定为: ")
(princ currSupportPath)
(princ " SupportPath范例\n")
(PROMPT "<Enter>进行:")
(VL-CMDF pause)
;;;改变SupportPath的值
(vla-put-SupportPath fileSel "TestSupportPath")
(setq newSupportPath (vla-get-SupportPath fileSel))
(princ "SupportPath的新值设定为: ")
(princ newSupportPath)
(princ " SupportPath范例\n")
(PROMPT "<Enter>进行:")
(VL-CMDF pause)
;;;将 SupportPath 重设为原来的值
(vla-put-SupportPath fileSel currSupportPath)
(vla-Regen AcadDocument acAllViewports)
(princ "SupportPath的值已经重设为: ")
(princ currSupportPath)
(princ " SupportPath范例\n")
(princ)
)
cabinsummer 发表于 2012-4-15 12:27
昨天的有误，今天更新如下：
代码很好用，谢谢分享。我修改了一下，这样就可以放在最前面或最后面：
(setq sp (getenv "ACAD"))
(setq path '("D:\\autocad1" "D:\\autocad2" "D:\\autocad3"))
;(foreach x path (setq sp (strcat sp ";" x))) ;文件搜索路径放在最后
(foreach x path (setq sp (strcat x ";" sp))) ;文件搜索路径放在最前
(setenv "ACAD" sp)
学习了~
(setq sp (getenv "ACAD"))
(setq path '("D:\\autocad1" "D:\\autocad2" "D:\\autocad3"))
(foreach x path (setq sp (strcat sp ";" x))) ;文件搜索路径放在最后
;(foreach x path (setq sp (strcat x ";" sp))) ;文件搜索路径放在最前
(setenv "ACAD" sp)
(princ) 本帖最后由 zhynt 于 2011-6-7 17:12 编辑
(defun StrUnParse (Lst Delimiter / return)
(setq return "")
(foreach str Lst
(setq return (strcat return Delimiter str))
)
(substr return 2)
)
(defun strParse (sstring sstr)
(setq string_list '())
(setq n1 (strlen sstring))
(setq n2 (strlen sstr))
(while (setq m2 (vl-string-search sstr sstring))
(setq str_1 (substr sstring 1 m2))
(setq sstring (substr sstring (+ 1 m2 n2)))
(if (/= str_1 "")
(setq string_list (cons str_1 string_list))
)
)
(if (/= sstring "")
(setq string_list (cons sstring string_list))
)
(reverse string_list)
)
(defun 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 ";"))
)
)
)
(AddSupportPath "D:\\autocad1" nil)
(AddSupportPath "D:\\autocad2" nil)
说明：当isFirst参数为“nil ”，添加路径到末尾，否则为开头。 先去试一下，谢谢！！ 好像不行啊。只能添加一个。。
还有我记得好像可以添加到第几列的？可以设置吗？ (defun strParse (sstring sstr)
(setq string_list '())
(setq n1 (strlen sstring))
(setq n2 (strlen sstr))
(while (setq m2 (vl-string-search sstr sstring))
(setq str_1 (substr sstring 1 m2))
(setq sstring (substr sstring (+ 1 m2 n2)))
(if (/= str_1 "")
(setq string_list (cons str_1 string_list))
)
)
(if (/= sstring "")
(setq string_list (cons sstring string_list))
)
(reverse string_list)
)
-----------------------------------------------------------------------
(defun StrUnParse (Lst Delimiter / return)
(setq return "")
(foreach str Lst
(setq return (strcat return Delimiter str))
)
(substr return 2)
)
(defun 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 ";"))
)
)
)
(AddSupportPath"C:\\test1"" ")
(AddSupportPath"C:\\test2"nil)
(AddSupportPath"C:\\test3"nil)
(AddSupportPath"C:\\test4"nil)
(princ)
是可以添加多个目录的，前提是这些目录是真实有效的。
如：我的c盘局部截图：
我原来的文件搜索列表：
添加后：
另外关于添加位置的问题，其实在什么位置是无关紧要的，只是有搜索的先后而已，如果有目录需要先搜索，可以加载其到开头。如上例的test1 多谢zhynt热心指导
会那么多,真佩服您.您做什么工作啊?
我做市政等设计,编autolisp程序纯粹是爱好,有时还挺上瘾,不过是挺费时间的. 我是做建筑设计的。 本帖最后由 tywsc 于 2011-6-15 20:37 编辑
回9#zhynt
您也是自学的吧,一边上班赶图,一边学编程---真的挺辛苦
您要是一线设计人,是不是也总加班啊.
我们基本就没歇过完整的假期.