Jump to content

Need to find all dwgs containing specific attribute text

DrWho

By DrWho
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

DrWho Apprentice

DrWho

Posted
Posted

I'm looking for a LISP routine, similar to MacAtt, that searches through all drawings in a folder and returns a list of those drawings which contain certain attribute text (in the values, not the tag names). I can't name the blocks ahead of time -- that's an unknown. Lots of great batch apps out there, but it seems like they all want to change something. I just want to find which drawing(s) (among dozens) contain, say, the "M7 LUBE PUMP". Help??

 

Thanks in advance!

DrWho Apprentice

DrWho

Posted
  • Author
Posted

Thanks, Lee. I am honored to bask in the glow of your luminosity.8)

Lee Mac Grand Master

Lee Mac

Posted
Posted

Haha thanks :)

 

Ok, give this a shot:

 

Here is my sub-function:

 

;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;
;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;
;;                                                                               ;;
;;                                                                               ;;
;;                       --=={  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  ~  [Optional]  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)

 

You can call it with this:

 

;; Test Function

(defun c:test (/ searchterm)

 (setq searchterm "M7 LUBE PUMP")

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

 

That will return a list of the drawing and the number of times the search term appears in the drawing.

 

Hope this helps!

 

Lee

alanjt Grand Master

alanjt

Posted
Posted

Just so you know, you can perform this search with Design Center.

designcenter.jpg

alanjt Grand Master

alanjt

Posted
Posted
That's where my inexperience in AutoCAD shows... o:)

 

Spend a little time with it. Autodesk thought of a few good things.

DrWho Apprentice

DrWho

Posted
  • Author
Posted

Wow! Fantastic.

 

Um...Hate to sound ignorant, but I'm new to all of this. What file name do I give to that OBDX file? (TheSwamp hasn't approved me yet. :x )

 

Thanks again.

alanjt Grand Master

alanjt

Posted
Posted
Wow! Fantastic.

 

Um...Hate to sound ignorant, but I'm new to all of this. What file name do I give to that OBDX file? (TheSwamp hasn't approved me yet. :x )

 

Thanks again.

Nothing against Lee, but you don't need it. Design Center has the option.

DrWho Apprentice

DrWho

Posted
  • Author
Posted

I'm trying this now and it seems to be doing just what I want. I tried the DataExtraction tool (which puts the data in a spreadsheet) but it just bogged down and hung. Didn't know DesignCenter did this!

 

To Lee, I am still grateful for your help, as I am trying to learn to LISP and I need all the good examples I can get!

alanjt Grand Master

alanjt

Posted
Posted
Didn't know DesignCenter did this!

All the more reason to learn the program before learning to program for it.

Lee Mac Grand Master

Lee Mac

Posted
Posted
Wow! Fantastic.

 

Um...Hate to sound ignorant, but I'm new to all of this. What file name do I give to that OBDX file? (TheSwamp hasn't approved me yet. :x )

 

Thanks again.

 

I realise you don't need to proceed in this way any more, but just to clarify.

 

I have posted all the code you need in my post in this thread. The filenames of the LISP's do not matter - you can even have both functions in the one file if you wish.

DrWho Apprentice

DrWho

Posted
  • Author
Posted

I was just a little slow on the uptake.

 

For the benefit of other lisp learners, what Lee was trying to tell me to do was to take the Test.lsp text and insert it directly into the Mac-ODBX code in place of the original "(defun c:test..." section. Then the MAC-ODBX code can be saved under any name (like "MAC-ODBX.lsp"). After loading MAC-ODBX.lsp, you just type TEST at the command line.

 

It runs very quickly, and the output is in a list form that can be further processed if desired.

 

I found that it's searching for an exact text match. For an inclusive text match, I replaced "(if (eq searchterm (vla-get-TextString att))" with "(if (wcmatch (vla-get-textstring att) (strcat "*" searchterm "*"))", based on another post at http://www.cadtutor.net/forum/showthread.php?t=19333. Either way works great.

 

Lee, thanks again for the help. I like it! And it was a great exercise, and a good basis for future lisping. Much obliged!

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...