高手帮忙看一下添加文件搜索路径的lsp

shep2008

在网上找到一个添加路径到CAD文件搜索路径的lsp如图所示位置，不知道要添加到哪里，请高手指点一下，例如我要添加D:\AutoCAD1和D:\autocad2两个路径，要怎么改下面的代码：

代码我话到二楼去了，放这里不会自动换行

shep2008

回复 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)

)

aichong

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)

Andyhon

...不需要指定好路径...

且问路径从何得来?
全盘搜寻?有着数个磁盘且有外接盘;
光盘也有可能有放...
再加上公司的Server环境
那得多少时间!?
遇上同名资料夹如何抉择!?


程序猿知道自家的果子挂何处
但所打造的钩子他人未必能一体适用啊

所以最好能自己量身打造
要不Autodesk早给了

zhynt

(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 ”，添加路径到末尾，否则为开头。

shep2008

先去试一下，谢谢！！

shep2008

好像不行啊。只能添加一个。。
还有我记得好像可以添加到第几列的？可以设置吗？

zhynt

2. (defun strParse (sstring sstr)
   
3.   (setq string_list '())
   
4.   (setq n1 (strlen sstring))
   
5.   (setq n2 (strlen sstr))
   
6.   (while (setq m2 (vl-string-search sstr sstring))
   
7.     (setq str_1 (substr sstring 1 m2))
   
8.     (setq sstring (substr sstring (+ 1 m2 n2)))
   
9.     (if (/= str_1 "")
   
10.       (setq string_list (cons str_1 string_list))
    
11.     )
    
12.   )
    
13.   (if (/= sstring "")
    
14.     (setq string_list (cons sstring string_list))
    
15.   )
    
16.   (reverse string_list)
    
17. )
    
18. -----------------------------------------------------------------------
    
19. (defun StrUnParse (Lst Delimiter / return)
    
20.   (setq return "")
    
21.   (foreach str Lst
    
22.     (setq return (strcat return Delimiter str))
    
23.   )
    
24.   (substr return 2)
    
25. )
    
26. (defun AddSupportPath (PathToAdd isFirst / supportlist)
    
27.   (if (not
    
28. (vl-string-search
    
29.    (strcase (strcat pathToAdd ";"))
    
30.    (strcase (strcat (getenv "ACAD") ";"))
    
31. )
    
32.       )
    
33.     (progn
    
34.       (setq supportlist (strparse (getenv "ACAD") ";"))
    
35.       (setq supportlist
    
36.       (vl-remove-if-not
    
37.         'vl-file-directory-p
    
38.         supportlist
    
39.       )
    
40.       )
    
41.       (if isFirst
    
42. (setq supportlist (cons PathToAdd supportlist))
    
43. (setq supportlist (append supportlist (list PathToAdd)))
    
44.       )
    
45.       (setenv "ACAD" (strUnParse supportlist ";"))
    
46.     )
    
47.   )
    
48. )
    
49. (AddSupportPath  "C:\\test1"  " ")
    
50. (AddSupportPath  "C:\\test2"  nil)
    
51. (AddSupportPath  "C:\\test3"  nil)
    
52. (AddSupportPath  "C:\\test4"  nil)
    
53. (princ)
    

(defun strParse (sstring sstr)<br />   (setq string_list '())<br />   (setq n1 (strlen sstring))<br />   (setq n2 (strlen sstr))<br />   (while (setq m2 (vl-string-search sstr sstring))<br />     (setq str_1 (substr sstring 1 m2))<br />     (setq sstring (substr sstring (+ 1 m2 n2)))<br />     (if (/= str_1 "")<br />       (setq string_list (cons str_1 string_list))<br />     )<br />   )<br />   (if (/= sstring "")<br />     (setq string_list (cons sstring string_list))<br />   )<br />   (reverse string_list)<br /> )<br /> -----------------------------------------------------------------------<br /> (defun StrUnParse (Lst Delimiter / return)<br />   (setq return "")<br />   (foreach str Lst<br />     (setq return (strcat return Delimiter str))<br />   )<br />   (substr return 2)<br /> )<br /> (defun AddSupportPath (PathToAdd isFirst / supportlist)<br />   (if (not<br /> (vl-string-search<br />    (strcase (strcat pathToAdd ";"))<br />    (strcase (strcat (getenv "ACAD") ";"))<br /> )<br />       )<br />     (progn<br />       (setq supportlist (strparse (getenv "ACAD") ";"))<br />       (setq supportlist<br />       (vl-remove-if-not<br />         'vl-file-directory-p<br />         supportlist<br />       )<br />       )<br />       (if isFirst<br /> (setq supportlist (cons PathToAdd supportlist))<br /> (setq supportlist (append supportlist (list PathToAdd)))<br />       )<br />       (setenv "ACAD" (strUnParse supportlist ";"))<br />     )<br />   )<br /> )<br /> (AddSupportPath  "C:\\test1"  " ")<br /> (AddSupportPath  "C:\\test2"  nil)<br /> (AddSupportPath  "C:\\test3"  nil)<br /> (AddSupportPath  "C:\\test4"  nil)<br /> (princ)<br />

是可以添加多个目录的，前提是这些目录是真实有效的。
如：我的c盘局部截图：
我原来的文件搜索列表：
添加后：

zhynt

另外关于添加位置的问题，其实在什么位置是无关紧要的，只是有搜索的先后而已，如果有目录需要先搜索，可以加载其到开头。如上例的test1

tywsc

多谢zhynt热心指导
会那么多,真佩服您.您做什么工作啊?
我做市政等设计,编autolisp程序纯粹是爱好,有时还挺上瘾,不过是挺费时间的.

zhynt

我是做建筑设计的。

tywsc

回9#zhynt
您也是自学的吧,一边上班赶图,一边学编程---真的挺辛苦
您要是一线设计人,是不是也总加班啊.
我们基本就没歇过完整的假期.