需要修改全局提取

clearwater304 · 发表于 2022-7-5 18:01:31

我正在使用Lee Mac的这个Autocad程序，它提取属性信息来创建图形的标题列表。该程序的工作原理是选择块，然后提取标签放入电子表格。有一个选项可以选择“所有标签”，但没有选择“所有块”的选项我想搜索数百个子目录中的数千张图纸，为我的所有公司图纸创建一个更新的图纸列表。

使用这个程序来实现这一点的问题；就是有很多不同的块名。这些年来，标题栏已经被更改了无数次，而且这些变化还没有被记录下来。我已经创建了一个宏，可以解释变化并将其转换到绘图列表中，但是我不擅长使用lisp。下面是代码的链接。是否可以修改它以包括“所有块”选项。

http://www.lee-mac.com/macatt.html

一种可能的替代方法是使用Lee Mac的子函数来创建所需的结果。使用ObjectDBX包装子函数中的“示例4”，我可以实现从单个文件夹中的所有图形中提取所有属性信息。如果下面的代码可以修改为搜索“所有子目录”，那么这也将达到预期的结果。

http://www.lee-mac.com/odbxbase.html

Lee Mac · 发表于 2022-7-5 18:22:51

您可以将“我的目录文件”功能与“浏览文件夹”功能和“我的ObjectDBX包装器”功能的示例4结合使用：

copy

(defun c:test4 ( / _getattributes data [highlight]dir[/highlight] file [highlight]lst[/highlight] name )
   (defun _getattributes ( doc / data item name values )
       (vlax-for layout (vla-get-layouts doc)
           (vlax-for object (vla-get-block layout)
               (if
                   (and
                       (eq "AcDbBlockReference" (vla-get-objectname object))
                       (eq :vlax-true (vla-get-hasattributes object))
                       (setq values
                           (mapcar
                               (function
                                   (lambda ( att )
                                       (cons
                                           (vla-get-tagstring att)
                                           (vla-get-textstring att)
                                       )
                                   )
                               )
                               (vlax-invoke object 'getattributes)
                           )
                       )
                   )
                   (if (setq item (assoc (setq name (vla-get-effectivename object)) data))
                       (setq data
                           (subst
                               (append item (list values))
                               item
                               data
                           )
                       )
                       (setq data (cons (list name values) data))
                   )
               )
           )
       )
       data
   )
   (if
       (and
           [highlight](setq dir  (LM:browseforfolder "Select a folder" nil 0))[/highlight]
           [highlight](setq lst  (LM:directoryfiles dir "*.dwg" t))[/highlight]
           (setq data (LM:ODBX '_getattributes [highlight]lst[/highlight] nil))
           (setq name (vl-filename-mktemp nil (getvar 'dwgprefix) ".txt"))
           (setq file (open name "w"))
       )
       (progn
           (foreach dwgitem data
               (write-line (car dwgitem) file)
               (princ "\n" file)
               (foreach item (cdr dwgitem)
                   (write-line (car item) file)
                   (foreach subitem (cdr item)
                       (princ subitem file)
                       (princ "\n" file)
                   )
                   (princ "\n" file)
               )
           )
           (close file)
           (startapp "notepad" name)
       )
   )
   (princ)
)