将指定路径下的所有目录添加到搜索路径

adc

麻烦帮忙看一下这个程序有什么问题，功能是将指定路径下的所有目录添加到搜索路径，参考了这个http://bbs.mjtd.com/thread-108706-1-1.html
(defun addsearchs(folderlst);;将folderlst里边的全路径目录添加到cad搜索支持
  (setenv"ACAD"(strcat(getenv "ACAD")(apply'strcat(mapcar'(lambda(x)(strcat";"x))folderlst))))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 用法：(qf_getFolder msg)
;; 例子：(qf_getFolder "选择文件夹:")
;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)

;;主程序
(defun c:tt()
(setq fold (qf_getFolder "选择文件所在目录:"))
(if fold
(progn
(setq file_list (GetFileList fold))
(if file_list

(addsearchs file_list)
)
)
)
(princ)
)

lxy_2080

GETFILELIST是什么函数？？

xyp1964

;; 未经测试，慎用！

2. ;; 将folderlst里边的全路径目录添加到cad搜索支持
   
3. (defun addsearchs (folderlst)
   
4.   (setenv "ACAD"
   
5.           (strcat (getenv "ACAD")
   
6.                   (apply 'strcat
   
7.                          (mapcar '(lambda (x) (strcat ";" x)) folderlst)
   
8.                   )
   
9.           )
   
10.   )
    
11. )
    
12. 
    
13. ;; PathAll 指定目录下的所有子目录 (PathAll path)
    
14. (defun PathAll (PathName / lst1 lst2 pa a pa1 b)
    
15.   (setq lst1 (list PathName)
    
16.         lst2 lst1
    
17.   )
    
18.   (while (setq pa (car lst1))
    
19.     (setq lst1 (cdr lst1))
    
20.     (foreach a (setq lst (cddr (vl-directory-files pa nil -1)))
    
21.       (setq pa1 (strcat pa "/" a))
    
22.       (if (setq b (cddr (vl-directory-files pa1 nil -1)))
    
23.         (setq b (mapcar '(lambda (x) (strcat pa1 "/" x)) b)
    
24.               lst2 (append b lst2)
    
25.               lst1 (append b lst1)
    
26.         )
    
27.       )
    
28.     )
    
29.   )
    
30.   (reverse lst2)
    
31. )
    
32. 
    
33. ;;主程序
    
34. (defun c:tt ()
    
35.   (if (setq lst (PathAll "d:\\xcad"))
    
36.     (addsearchs lst)
    
37.   )
    
38.   (princ)
    
39. )

;; 将folderlst里边的全路径目录添加到cad搜索支持<br /> (defun addsearchs (folderlst)<br />   (setenv "ACAD"<br />           (strcat (getenv "ACAD")<br />                   (apply 'strcat<br />                          (mapcar '(lambda (x) (strcat ";" x)) folderlst)<br />                   )<br />           )<br />   )<br /> )<br /> <br /> ;; PathAll 指定目录下的所有子目录 (PathAll path)<br /> (defun PathAll (PathName / lst1 lst2 pa a pa1 b)<br />   (setq lst1 (list PathName)<br />         lst2 lst1<br />   )<br />   (while (setq pa (car lst1))<br />     (setq lst1 (cdr lst1))<br />     (foreach a (setq lst (cddr (vl-directory-files pa nil -1)))<br />       (setq pa1 (strcat pa "/" a))<br />       (if (setq b (cddr (vl-directory-files pa1 nil -1)))<br />         (setq b (mapcar '(lambda (x) (strcat pa1 "/" x)) b)<br />               lst2 (append b lst2)<br />               lst1 (append b lst1)<br />         )<br />       )<br />     )<br />   )<br />   (reverse lst2)<br /> )<br /> <br /> ;;主程序<br /> (defun c:tt ()<br />   (if (setq lst (PathAll "d:\\xcad"))<br />     (addsearchs lst)<br />   )<br />   (princ)<br /> )

shh1980

院长真是乐于助人，致敬！来自: Android客户端

vectra

目测比院长的代码慢十倍