Listing Layers In Multiple Drawings?

January 15, 2010

I need a a program that can give me a list of all the layers that exist in multiple drawings.

Anyone know of such a program?

January 15, 2010

Here are three different ways of getting a list of layers:

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

Interesting Speed result:

Elapsed milliseconds / relative speed for 4096 iteration(s):

   (GETLAYERS3).....1123 / 1.40 <fastest>
   (GETLAYERS1).....1264 / 1.25
   (GETLAYERS2).....1576 / 1.00 <slowest>

What exactly were you looking for when you say getting the list from multiple drawings? A list in the command line? Multiple Drawing run through a script/ObjectDBX? All open drawings?

Lee

January 15, 2010

Here is my issue... I have a folder full of drawings that I need to go through to make sure each drawing has the correct layers and each layer has the correct properties.

January 15, 2010

Here is my issue... I have a folder full of drawings that I need to go through to make sure each drawing has the correct layers and each layer has the correct properties.

ObjectDBX would be the quickest method, I would think that you would need to make a table of "correct" values to check against.

January 15, 2010

ObjectDBX would be the quickest method, I would think that you would need to make a table of "correct" values to check against.

With the amount of drawings that I need to go through and the amount of layers in each drawing, I think making a table of the correct values would be very time consuming. I thought project manager had the abuility to tell me what layers are in what drawings, but I don't belive it does. I am kinda looking for a program, similar to project manager, but that gives me the layers and layer properties in each drawing.

January 15, 2010

With the amount of drawings that I need to go through and the amount of layers in each drawing, I think making a table of the correct values would be very time consuming. I thought project manager had the abuility to tell me what layers are in what drawings, but I don't belive it does. I am kinda looking for a program, similar to project manager, but that gives me the layers and layer properties in each drawing.

But then you would have to look through each listing to make sure it is correct...

Surely it would be better to have a table of the correct properties for each layer, and then make a list of the drawings that don't fit the table..

January 15, 2010

But then you would have to look through each listing to make sure it is correct...

Surely it would be better to have a table of the correct properties for each layer, and then make a list of the drawings that don't fit the table..

I agree with you, however I am trying to pull this layer check off at the last minute and really don't have the time, this time, to make a table of correct properties. I am after a possible quick solution, and plan to find a more feasible solution when I have more time to do so. This was pushed on me at the last minute unfortunately.

January 15, 2010

I was thinking of finding a command that would make a list per drawing and use it in a script to run it using a batch run program like EZ Script Pro.

January 15, 2010

Try this mate, will write results to output file:

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

January 15, 2010

That is exactly what I am looking for!!! Thank you very much Lee Mac! I believe to make this match perfectly to what I am looking for I would need to add to the list it creates the properties of each layer, but like I said before I am in no rush to do that.

January 15, 2010

How about this?

(defun c:CheckLayers (/ *error* ObjRelease DirDialog Get_Subs ObjectDBXDocument GetLayers Str-Make

                       DBX DOCLST 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 GetLayerProperties (doc / lst)
   (vlax-for lay (vla-get-Layers doc)
     (setq lst (cons
                 (mapcar
                   (function
                     (lambda (property)
                       (vl-princ-to-string
                         (vlax-get-property lay property))))

                   '(Name Color Linetype LineWeight))

                 lst)))
   
   (vl-sort lst
     (function
       (lambda (a b) (< (car a) (car b))))))

 
 (defun Str-Make (lst del / Pad str x)

   (defun Pad (pStr pDel Len)
     (while (< (strlen pStr) Len)
       (setq pStr (strcat pStr pDel)))
     pStr)
   
   (setq str  (Pad (car lst) (chr 32) 30))
   (foreach x (cdr lst)
     (setq str (strcat Str Del (Pad x (chr 32) 30))))
   
 str)
 

 (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*)))

     (vlax-for doc (vla-get-Documents *acad)
       (setq DocLst (cons (cons (vla-get-FullName doc) doc) DocLst)))
     

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

       (setq dbx (cdr (assoc dwg DocLst)))        

       (and (not dbx) (setq dbx (ObjectDBXDocument)))
       

       (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply
                     (function vla-open) (list dbx dwg))))

         (setq Layer_List (cons (cons dwg (GetLayerProperties dbx)) Layer_List))))

     (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)
           (write-line (Str-Make '("Name" "Colour" "LineType" "LineWeight") (chr 32)) ofile)
           (mapcar
             (function
               (lambda (y)
                 (write-line
                   (Str-Make y (chr 32)) ofile))) (cdr x))
           
           (write-line "\n" ofile)))

       Layer_List)

     (close ofile))

   (princ "\n*Cancel*"))

 (princ))

January 15, 2010

OOO... Thats really sweet!

January 15, 2010

This has a better spacing function:

(defun c:CheckLayers (/ *error* ObjRelease DirDialog Get_Subs ObjectDBXDocument GetLayers Str-Make

                       DBX DOCLST 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 GetLayerProperties (doc / lst)
   (vlax-for lay (vla-get-Layers doc)
     (setq lst (cons
                 (mapcar
                   (function
                     (lambda (property)
                       (vl-princ-to-string
                         (vlax-get-property lay property))))

                   '(Name Color Linetype LineWeight))

                 lst)))
   
   (vl-sort lst
     (function
       (lambda (a b) (< (car a) (car b))))))

 
 (defun Str-Make  (lst del / Pad str x i)
   (setq i 10)

   (defun Pad  (Str Del Len)
     (while (>= (strlen Str) Len) (setq Len (+ Len 5)))
     (while (< (strlen Str) Len)
       (setq Str (strcat Str Del)))
     Str)

   (apply (function strcat)
          (reverse
            (cons (last lst)
                  (mapcar
                    (function
                      (lambda ($str)
                        (Pad $str del
                             (setq i (abs (- 40 i))))))

                    (cdr (reverse 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*)))

     (vlax-for doc (vla-get-Documents *acad)
       (setq DocLst
         (cons (cons (strcase (vla-get-FullName doc)) doc) DocLst)))
     

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

       (setq dbx (cdr (assoc (strcase dwg) DocLst)))        

       (and (not dbx) (setq dbx (ObjectDBXDocument)))
       

       (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply
                     (function vla-open) (list dbx dwg))))

         (setq Layer_List (cons (cons dwg (GetLayerProperties dbx)) Layer_List))
         (setq Layer_List (cons (cons dwg '(("**Error Opening this Drawing **"))) Layer_List))))
               

     (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)
           (write-line (Str-Make '("Name" "Colour" "LineType" "LineWeight") (chr 32)) ofile)
           (mapcar
             (function
               (lambda (y)
                 (write-line
                   (Str-Make y (chr 32)) ofile))) (cdr x))
           
           (write-line "\n" ofile)))

       Layer_List)

     (close ofile))

   (princ "\n*Cancel*"))

 (princ))

April 2, 2017

This is some really amazing work.:shock:

Big fan of you Lee Mac.

The code rellay saved me alot of time. But i am wandering if you can help me to make the code to ignore all the xref.

April 2, 2017

This is some really amazing work.:shock:
Big fan of you Lee Mac.

The code rellay saved me alot of time. But i am wandering if you can help me to make the code to ignore all the xref.

Thank you for your kind words MihaiT, and welcome to CADTutor.

This thread contains some very old code! - This program has since evolved to become my Layer Extractor application, which offers the option to include/exclude xref-dependent layers from the output.

I'm pleased that you find the code useful!

Lee

October 20, 2022

On 4/3/2017 at 2:14 AM, Lee Mac said:

Thank you for your kind words MihaiT, and welcome to CADTutor.

This thread contains some very old code! - This program has since evolved to become my Layer Extractor application, which offers the option to include/exclude xref-dependent layers from the output.

I'm pleased that you find the code useful!

Lee

Lee Mac The Great

You alone have the best answers for every question.

You don't know me, but I am proud to be your fan in anonymity.

Davood Mi.

Sign In

Listing Layers In Multiple Drawings?

Recommended Posts

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

MihaiT

Lee Mac

Davood Mi.

Join the conversation

Tutorials

Forums

Activity