[编程交流] 菜单和宏

(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 )
 ;; © 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)
 )
)