需要找到所有包含的DWG
我正在寻找一个类似于MacAtt的LISP例程，它搜索文件夹中的所有图形，并返回包含某些属性文本（在值中，而不是在标记名中）的图形列表。我不能提前说出这些街区的名字——这是个未知数。有很多很棒的批量应用程序，但似乎他们都想改变一些东西。我只想找出哪些图纸（在几十张图纸中）包含，例如“M7润滑泵”。帮助提前感谢！ 你好，何博士，
我很高兴你喜欢我的MacAtt计划
我还编写了一个批处理ObjectDBX程序，该程序只需要一个函数参数即可处理。
请参见此处：
http://www.theswamp.org/index.php?topic=31827.0
如果我有时间，我会写一个函数，你可以输入它 谢谢你，李。我很荣幸能沐浴在你的光辉之中。 哈哈谢谢
好的，试一试：
这是我的子功能：
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;
;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;
;; ;;
;; ;;
;; --=={ObjectDBX Base Program}==-- ;;
;; ;;
;;Provides a shell through which a LISP may operate on multiple drawings in a;;
;;folder/sub-folders. ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;;AUTHOR: ;;
;; ;;
;;Copyright © Lee McDonnell, January 2010. All Rights Reserved. ;;
;; ;;
;; { Contact: Lee Mac @ TheSwamp.org, CADTutor.net } ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;;ARGUMENTS: ;;
;; ;;
;;foo~a function taking a single argument (the Document Object), and ;;
;; following the 'rules' of ObjectDBX: ;;
;; ;;
;; - No SelectionSets (ssget,ssname etc.) ;;
;; - No Command calls ;;
;; - No *Ent Methods (entget,entmod etc.) ;;
;; - No Access to System Variables(vla-Set/GetVariable, etc) ;;
;; ;;
;;dwgLst~A list of dwg filepaths to process, if nil, program ;;
;; will display BrowseForFolder dialog. ;;
;; ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;
;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;
(defun Mac-ODBX (foo dwgLst / *error* ObjRelease Get_Subs DirDialog ObjectDBXDocument
DBX DBXDOC DOCLST DWGLST ERR FILE FILEPATH FLAG FOLDER PATH RESULT SUBS)
(vl-load-com)
(setq *acad (cond (*acad) ((vlax-get-acad-object)))
*adoc (cond (*adoc) ((vla-get-ActiveDocument *acad))))
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
(defun *error* (msg)
(ObjRelease (list dbx dbxdoc))
(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 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 DirDialog (msg dir flag / Shell Fold Path)
; Lee Mac~ 07.06.09
(setq *acad (cond (*acad) ((vlax-get-acad-object))))
(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 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)))))
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
(if (setq dwgLst
(cond (dwgLst)
((setq Path (DirDialog "Select Directory to Process" nil 0))
(initget "Yes No")
(setq subs (cond ((getkword "\nProcess SubDirectories? <Yes> : ")) ("Yes")))
(apply (function append)
(vl-remove 'nil
(mapcar
(function
(lambda (Filepath)
(mapcar
(function
(lambda (Filename)
(strcat Filepath "\\" Filename)))
(vl-directory-files Filepath "*.dwg" 1))))
(append (list Path)
(apply (function append)
(if (= "Yes" subs) (Get_Subs Path))))))))))
(progn
(vlax-for doc (vla-get-Documents *acad)
(setq DocLst
(cons
(cons
(strcase
(vla-get-fullname doc)) doc) DocLst)))
(setq dbxdoc (ObjectDBXDocument))
(foreach dwg dwgLst
(setq flag (and (setq dbx (cdr (assoc (strcase dwg) DocLst)))))
(and (not flag)
(setq Err (vl-catch-all-apply
(function vla-open) (list dbxdoc dwg)) dbx dbxdoc))
(if (or flag (not (vl-catch-all-error-p Err)))
(setq Result (cons (cons dwg ((eval foo) dbx)) Result))
(princ (strcat "\n** Error Opening File: " (vl-filename-base dwg)".dwg **"))))))
(ObjRelease (list dbx dbxdoc))
Result)
你可以这样称呼它：
;; Test Function
(defun c:test (/ searchterm)
(setq searchterm "M7 LUBE PUMP")
(Mac-ODBX
'(lambda (document / i) (setq i 0)
(vlax-for lay (vla-get-layouts document)
(vlax-for obj (vla-get-block lay)
(if (and (eq "AcDbBlockReference"
(vla-get-Objectname obj))
(eq :vlax-true (vla-get-hasAttributes obj)))
(foreach att (append (vlax-invoke obj 'GetAttributes)
(vlax-invoke obj 'GetConstantAttributes))
(if (eq searchterm (vla-get-TextString att))
(setq i (1+ i)))))))
i)
nil))
(princ))
这将返回图形列表以及搜索项在图形中出现的次数。
希望这有帮助！
李 正如你们所知，你们可以使用设计中心进行搜索。
这就是我对AutoCAD缺乏经验的地方。。。
花点时间在上面。Autodesk想到了一些好事情。 哇！好极了
嗯。。。我不想听起来很无知，但我对这一切都不熟悉。我给那个OBDX文件取什么文件名？（TheSwamp还没有批准我。）
再次感谢。 没有什么反对李的，但你不需要。设计中心可以选择。 我现在正在尝试，它似乎正是我想要的。我尝试了DataExtraction工具（将数据放入电子表格），但它只是停滞不前。不知道设计中心这么做！
对于李，我仍然很感谢你的帮助，因为我正在努力学习LISP，我需要所有我能得到的好例子！
页:
[1]
2