[编程交流] 在多个Dra中列出图层

(defun GetLayers1 (/ lst)
 (vlax-map-collection
   (vla-get-Layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (function (lambda (x) (setq lst (cons (vla-get-name x) lst)))))
lst)

(defun GetLayers2 (/ tdef lst)
 (while (setq tdef (tblnext "LAYER" (not tdef)))
   (setq lst (cons (cdr (assoc 2 tdef)) lst)))
lst)

(defun GetLayers3 (/ lst)
 (vlax-for lay (vla-get-Layers
                 (vla-get-ActiveDocument
                   (vlax-get-acad-object)))
   (setq lst (cons (vla-get-name lay) lst)))
lst)

Elapsed milliseconds / relative speed for 4096 iteration(s):
   (GETLAYERS3).....1123 / 1.40 <fastest>
   (GETLAYERS1).....1264 / 1.25
   (GETLAYERS2).....1576 / 1.00 <slowest>

(defun c:CheckLayers (/ *error* ObjRelease DirDialog Get_Subs ObjectDBXDocument GetLayers
                       DBX DWLST FILE FOLDER LAYER_LIST PATH SHELL)
 (vl-load-com)
 ;; Lee Mac  ~  15.01.10
 
 (defun *error* (msg)
   (ObjRelease (list Shell dbx))
   (and ofile (= (type ofile) 'FILE) (close ofile))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 (defun ObjRelease (lst)
   (mapcar
     (function
       (lambda (x)
         (if (and (eq (type x) 'VLA-OBJECT)
                  (not (vlax-object-released-p x)))
           (vl-catch-all-apply
             (function vlax-release-object) (list x))))) lst))
 (defun DirDialog (msg dir flag / Shell Fold Path)
   ;; Lee Mac  ~  07.06.09
   
   (setq Shell (vla-getInterfaceObject *acad "Shell.Application")
         Fold  (vlax-invoke-method Shell 'BrowseForFolder
                 (vla-get-HWND *acad) msg flag dir))
   (vlax-release-object Shell)
   
   (if Fold
     (progn
       (setq Path (vlax-get-property
                    (vlax-get-property Fold 'Self) 'Path))
       (vlax-release-object Fold)
       
       (and (= "\" (substr Path (strlen Path)))
            (setq Path (substr Path 1 (1- (strlen Path)))))))
   
   Path) 
 (defun Get_Subs (folder / file) ;; CAB
   (mapcar
     (function
       (lambda (x) (setq file (strcat folder "\" x))
                   (cons file (apply (function append) (get_subs file)))))
       (cddr (vl-directory-files folder nil -1))))
 
 (defun ObjectDBXDocument (/ acVer)
   
   (vla-GetInterfaceObject *acad
     (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument"
       (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))
 
 (defun GetLayers (doc / lst)
   (vlax-for lay (vla-get-Layers doc)
     (setq lst (cons (vla-get-name lay) lst)))
 (acad_strlsort lst))
 
 (setq *acad (cond (*acad) ((vlax-get-acad-object)))
       *doc  (cond (*doc ) ((vla-get-ActiveDocument *acad))))
 (or *def* (setq *def* "Yes"))
 
 (if (and (setq Path (DirDialog "Select Directory" nil 0))
          (vl-file-directory-p Path)
          (setq outfile (getfiled "Output File" "" "txt" 1)))
   (progn
     (initget "Yes No")
     (setq *def* (cond ((getkword
                          (strcat "\nProcess SubDirectories? <" *def* "> : "))) (*def*)))
     (princ "\n>> Processing...")
     (foreach dwg  (setq dwLst (apply (function append)
                                      (vl-remove 'nil
                                        (mapcar
                                          (function
                                            (lambda (Path)
                                              (mapcar
                                                (function
                                                  (lambda (File)
                                                    (strcat Path "\" File)))
                                                (vl-directory-files Path "*.dwg" 1))))
                                          (append (list Path)
                                                  (apply (function append)
                                                         (if (= "YES" (strcase *def*))
                                                           (Get_Subs Path))))))))      
       (vlax-for doc (vla-get-Documents *acad)
         (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
              (setq dbx doc)))
       (and (not dbx) (setq dbx (ObjectDBXDocument)))
       
       (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply
                     (function vla-open) (list dbx dwg))))
         (progn
           (princ (chr 46))
           (setq Layer_List (cons (cons dwg (GetLayers dbx)) Layer_List))
         ) ; Progn
       ))
     (princ (strcat "\n<< " (itoa (length dwLst)) " Drawings Processed >>")))
   
   (princ "*Cancel*"))
 (ObjRelease (list Shell dbx)) (gc) (gc)
 (if (and Layer_List
         (setq ofile (open outfile "w")))
   (progn
     
     (mapcar
       (function
         (lambda (x)
           (write-line (car x) ofile)
           (mapcar
             (function
               (lambda (y)
                 (write-line y ofile))) (cdr x))
           (write-line "\n" ofile)))
       Layer_List)
     (close ofile))
   (princ "\n*Cancel*"))
 (princ))