Lee Mac 发表于 2022-7-6 11:45:54

你的意思是在计算机上创建目录结构或通过LISP添加支持路径?

mitchellrodhous 发表于 2022-7-6 11:48:30

通过LISP添加支持路径;)

Lee Mac 发表于 2022-7-6 11:54:48

是的,可以这样做:
 
添加/删除支持路径:

(defun LM:AddSupportPaths ( lst / PreferenceFiles SupportPaths )
;; © Lee Mac~14.06.10
;; (AddSupportPaths '("C:\\Folder" "C:\\Folder\\Subfolder" ... )
(vl-load-com)

(setq SupportPaths
   (vla-get-SupportPath
   (setq PreferenceFiles
       (vla-get-files
         (vla-get-preferences
         (vlax-get-acad-object)
         )
       )
   )
   )
)

(vla-put-SupportPath PreferenceFiles
   (LM:lst->str
   (cons SupportPaths
       (vl-remove-if
         (function
         (lambda ( s )
             (vl-string-search s SupportPaths)
         )
         )
         lst
       )
   )
   ";"
   )
)
lst
)

(defun LM:RemoveSupportPaths ( lst / PreferenceFiles SupportPaths )
;; © Lee Mac~14.06.10
;; (RemoveSupportPaths '("C:\\Folder" "C:\\Folder\\Subfolder" ... )
(vl-load-com)

(setq SupportPaths
   (vla-get-SupportPath
   (setq PreferenceFiles
       (vla-get-files
         (vla-get-preferences
         (vlax-get-acad-object)
         )
       )
   )
   )
)

(vla-put-SupportPath PreferenceFiles
   (LM:lst->str
   (vl-remove-if
       (function
         (lambda ( s )
         (vl-position s lst)
         )
       )
       (LM:StringParser SupportPaths ";")
   )
   ";"
   )
)
lst
)

(defun LM:lst->str ( lst del )
;; © Lee Mac~14.06.10
(if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
)
)

(defun LM:StringParser ( str del / pos )
;; © Lee Mac~14.06.10
(if (setq pos (vl-string-search del str))
   (cons (substr str 1 pos)
         (LM:StringParser (substr str (+ pos 1 (strlen del))) del))
   (list str)
)
)

 
创建目录结构:
5

mitchellrodhous 发表于 2022-7-6 11:58:24

是的,这就是我需要的。谢谢你,李
尊敬的先生

Lee Mac 发表于 2022-7-6 12:02:25

不客气。
页: 1 [2]
查看完整版本: 支持路径操作