routine to list all layer'
Do you know any routine to list all layer's names in a text file or Excel sheet?Please help. Tkx. Phiphi:
It is generally not a good idea to append a new question to an existing thread even if the subject seems to be similar.In the future, start a new thread.Thanks.
But don't be too disappointed.I found exactly what you need at the link below.When you get to the web page, scroll down to the section called Layer Management and look for a routine called laylst.lsp.This lisp routine will, according to its author, "generate a sorted list of layer names in a drawing".
http://paracadd.com/lisp.htm
By the way, the tip jar is on the counter.
Open the Layer Manager>Select all (Ctrl+A)>Copy (Ctrl+C)>Open Excel or Notepad and paste the contents.
I've used this routine in the past. Don't know who wrote it or where I got it. I've had it for ages.
Edit: This request has been moved to it's own thread and placed in the Customization section. I wrote this a while back, will process all drawings in a directory (and subdirectories):
(defun c:CheckLayers ( / *error* DBX DOCLST FILES FLAG LAYER_LIST ODOC OFILE OUTFILE 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) ) (setq *acad (cond (*acad) ((vlax-get-acad-object))) *doc(cond (*doc ) ((vla-get-ActiveDocument *acad)))) (if (and (setq Files (GetAllFiles nil t "*.dwg")) (setq outfile (getfiled "Output File" "" "txt" 1))) (progn (vlax-for doc (vla-get-Documents *acad) (setq DocLst (cons (cons (strcase (vla-get-FullName doc)) doc) DocLst ) ) ) (setq dbx (ObjectDBXDocument)) (foreach dwg Files (cond ((setq flag (and (setq oDoc (cdr (assoc (strcase dwg) DocLst)) ) ) ) ) (t (setq flag (not (vl-catch-all-error-p (vl-catch-all-apply (function vla-open) (list dbx dwg) ) ) ) ) (setq oDoc dbx) ) ) (setq Layer_List (if flag (cons (cons dwg (GetLayerProperties oDoc)) Layer_List) (cons (cons dwg '(("**Error Opening this Drawing **"))) Layer_List) ) ) ) (princ (strcat "\n>")) ) (princ "*Cancel*") ) (vlax-release-object dbx) (gc) (gc) (if (and Layer_List (setq ofile (open outfile "w"))) (progn (mapcar (function (lambda (x) (write-line (car x) ofile) (write-line (MakeString '("Name" "Colour" "LineType" "LineWeight") (chr 32)) ofile) (mapcar (function (lambda (y) (write-line (MakeString y (chr 32)) ofile ) ) ) (cdr x) ) (write-line "\n" ofile) ) ) Layer_List ) (close ofile) ) (princ "\n*Cancel*") ) (princ))(defun ObjectDBXDocument ( / acVer ) (setq *acad (cond (*acad) ((vlax-get-acad-object))))(vla-GetInterfaceObject *acad (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)) ) ))(defun GetAllFiles ( Dir Subs Filetype / GetSubFolders Shell Fold Dir ) (vl-load-com) ;; Lee Mac~17.01.10(defun GetSubFolders ( folder / _f ) (mapcar (function (lambda ( f ) (setq _f (strcat folder "\\" f)) (cons _f (apply (function append) (GetSubFolders _f))) ) ) (cddr (vl-directory-files folder nil -1)) ) ) (cond ( (not (or (and Dir (vl-file-directory-p Dir)) (progn (setq Shell (vla-getInterfaceObject (setq acad (vlax-get-acad-object)) "Shell.Application") Fold(vlax-invoke-method Shell 'BrowseForFolder (vla-get-HWND acad) "Select Directory" 512)) (vlax-release-object Shell) (if Fold (progn (setq Dir (vlax-get-property (vlax-get-property Fold 'Self) 'Path)) (vlax-release-object Fold) (and (= "\\" (substr Dir (strlen Dir))) (setq Dir (substr Dir 1 (1- (strlen Dir))))) Dir ) ) ) ) ) ) ( (apply (function append) (vl-remove (quote nil) (mapcar (function (lambda (Filepath) (mapcar (function (lambda (Filename) (strcat Filepath "\\" Filename) ) ) (vl-directory-files Filepath Filetype 1) ) ) ) (append (list Dir) (apply (function append) (if subs (GetSubFolders Dir)) ) ) ) ) ) ) ))(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 MakeString( 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)) ) ) ) ))
页:
[1]