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)) ) ) ) )) 
置顶卡
