在多个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>
当你说从多个图形中获取列表时,你到底在寻找什么?命令行中的列表?通过脚本/ObjectDBX运行多个图形?所有打开的图纸?
李 这是我的问题。。。我有一个文件夹,里面装满了我需要查看的图纸,以确保每个图纸都有正确的图层,每个图层都有正确的属性。
ObjectDBX将是最快的方法,我认为您需要制作一个包含“正确”值的表来进行检查。
考虑到我需要浏览的图形数量和每个图形中的图层数量,我认为制作一个包含正确值的表格将非常耗时。我以为项目经理有能力告诉我什么图纸中有哪些层,但我不相信它有能力。我有点想找一个程序,类似于项目经理,但这给了我每个图形中的图层和图层属性。
但是,你必须仔细查看每个列表,以确保它是正确的。。。
当然,最好为每一层准备一个正确属性的表格,然后列出不符合表格的图纸。。
我同意你的观点,但是我在最后一分钟试图完成这个图层检查,这次我真的没有时间制作一个正确属性的表。我正在寻找一个可能的快速解决方案,并计划在有更多时间时找到一个更可行的解决方案。不幸的是,这是在最后一刻强加给我的。 我正在考虑找到一个命令,该命令可以为每个图形创建一个列表,并在脚本中使用它,使用EZ script Pro之类的批处理运行程序来运行它。 尝试此配对,将结果写入输出文件:
(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))
这正是我想要的!!!非常感谢李!我相信,要使这一点与我所寻找的完美匹配,我需要将其添加到列表中,它会创建每个层的属性,但正如我之前所说,我并不急于这样做。
页:
[1]
2