将指定路径下的所有目录添加到搜索路径
麻烦帮忙看一下这个程序有什么问题，功能是将指定路径下的所有目录添加到搜索路径，参考了这个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)
)
GETFILELIST是什么函数？？ ;; 未经测试，慎用！;; 将folderlst里边的全路径目录添加到cad搜索支持
(defun addsearchs (folderlst)
(setenv "ACAD"
(strcat (getenv "ACAD")
(apply 'strcat
(mapcar '(lambda (x) (strcat ";" x)) folderlst)
)
)
)
)
;; PathAll 指定目录下的所有子目录 (PathAll path)
(defun PathAll (PathName / lst1 lst2 pa a pa1 b)
(setq lst1 (list PathName)
lst2 lst1
)
(while (setq pa (car lst1))
(setq lst1 (cdr lst1))
(foreach a (setq lst (cddr (vl-directory-files pa nil -1)))
(setq pa1 (strcat pa "/" a))
(if (setq b (cddr (vl-directory-files pa1 nil -1)))
(setq b (mapcar '(lambda (x) (strcat pa1 "/" x)) b)
lst2 (append b lst2)
lst1 (append b lst1)
)
)
)
)
(reverse lst2)
)
;;主程序
(defun c:tt ()
(if (setq lst (PathAll "d:\\xcad"))
(addsearchs lst)
)
(princ)
) 院长真是乐于助人，致敬！ 目测比院长的代码慢十倍
页:
[1]