AQucsaiJr 发表于 2022-7-5 16:31:44

在多个Dra中列出图层

我需要一个程序,可以给我一个在多个图形中存在的所有图层列表。
有人知道这样的节目吗?

Lee Mac 发表于 2022-7-5 16:38:36

以下是获取层列表的三种不同方法:
 

(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运行多个图形?所有打开的图纸?
 
 

AQucsaiJr 发表于 2022-7-5 16:43:52

这是我的问题。。。我有一个文件夹,里面装满了我需要查看的图纸,以确保每个图纸都有正确的图层,每个图层都有正确的属性。

Lee Mac 发表于 2022-7-5 16:47:53

 
ObjectDBX将是最快的方法,我认为您需要制作一个包含“正确”值的表来进行检查。

AQucsaiJr 发表于 2022-7-5 16:51:33

 
 
考虑到我需要浏览的图形数量和每个图形中的图层数量,我认为制作一个包含正确值的表格将非常耗时。我以为项目经理有能力告诉我什么图纸中有哪些层,但我不相信它有能力。我有点想找一个程序,类似于项目经理,但这给了我每个图形中的图层和图层属性。

Lee Mac 发表于 2022-7-5 16:56:21

 
但是,你必须仔细查看每个列表,以确保它是正确的。。。
 
当然,最好为每一层准备一个正确属性的表格,然后列出不符合表格的图纸。。

AQucsaiJr 发表于 2022-7-5 16:59:58

 
 
我同意你的观点,但是我在最后一分钟试图完成这个图层检查,这次我真的没有时间制作一个正确属性的表。我正在寻找一个可能的快速解决方案,并计划在有更多时间时找到一个更可行的解决方案。不幸的是,这是在最后一刻强加给我的。

AQucsaiJr 发表于 2022-7-5 17:04:20

我正在考虑找到一个命令,该命令可以为每个图形创建一个列表,并在脚本中使用它,使用EZ script Pro之类的批处理运行程序来运行它。

Lee Mac 发表于 2022-7-5 17:09:11

尝试此配对,将结果写入输出文件:
 

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

         

AQucsaiJr 发表于 2022-7-5 17:12:06

这正是我想要的!!!非常感谢李!我相信,要使这一点与我所寻找的完美匹配,我需要将其添加到列表中,它会创建每个层的属性,但正如我之前所说,我并不急于这样做。
页: [1] 2
查看完整版本: 在多个Dra中列出图层