Update title block attributes in multiple drawings

[au-s]

Hey ..

 

I mamanged to do it much cleaner...

 

But it overrites all attributes... but not in all cases ...

That happens only if I change some tags in a block. Other tags works fine...

Why?

 

 

Thank You!

 

;; Global Attribute Changer
;; Copyright (c) Lee McDonnell 11.06.2009
;; Credit to Tony Tanzillo, Tim Willey.
(defun c:MAcAtt (/ *error* *acad vl ov blkNme tdef
                  ss bTest attlst Shell  fDir Dir
                  acVer dbx dwLst prelst postlst)
 (vl-load-com)
 ;; Error Handler
 (defun *error* (e)
   (if ov (mapcar 'setvar vl ov))
   (ObjRel (list Shell dbx *acad))
   (if (not (wcmatch (strcase e) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " e " >>")))
   (princ))
 (setq vl '("CMDECHO")
       ov (mapcar 'getvar vl))
 (setvar "CMDECHO" 0)        
 ;; Get Block
 (while
     (progn
       (not (initget "Name"))
       (setq blkNme
              (entsel "\nSelect Block or [Name]: "))
       (cond
         ((and (vl-consp blkNme)
               (eq "INSERT" (cdr (assoc 0 (entget (car blkNme)))))
               (eq 1 (cdr (assoc 66 (entget (car blkNme))))))
          (setq blkNme (cdr (assoc 2 (entget (car blkNme)))))
          nil) ; Exit Loop
         ((eq 'STR (type blkNme))
          (setq blkNme (getstring t "\nSpecify Block Name: "))
          (cond ((and (setq tdef (tblsearch "BLOCK" blkNme))
                      (eq 2 (logand (cdr (assoc 70 tdef)) 2)))
                 nil) ; Exit Loop
                ((tblsearch "BLOCK" blkNme)
                 (princ "\n<< Block Contains No Attributes >>"))
                (t (princ "\n<< Block Not Found >>")))) ; Keep in Loop
         (t (princ "\nMissed, Try Again...")))))
 ;; Get Attribute Values
 (if (setq ss
       (ssget "_X" (list (cons 0 "INSERT")
                         (cons 2 blkNme)
                         (cons 66 1))))
   (progn
     (initdia 1)
     (setq bTest (ssname ss 0))
     (foreach att (vlax-safearray->list
                    (vlax-variant-value
                      (vla-getAttributes
                        (vlax-ename->vla-object bTest))))
       (setq prelst
         (cons
           (cons
             (vla-get-TagString att)
               (vla-get-TextString att)) prelst)))
     (vl-cmdf "_.attedit" bTest)
     (foreach att (vlax-safearray->list
                    (vlax-variant-value
                      (vla-getAttributes
                        (vlax-ename->vla-object bTest))))
       (setq postlst
         (cons
           (cons
             (vla-get-TagString att)
               (vla-get-TextString att)) postlst)))
     (setq attlst (vl-remove-if
                    (function
                      (lambda (x)
                        (vl-position x prelst))) postlst))
 ;; Get Directory
 (setq *acad (vlax-get-acad-object)
       Shell (vla-getInterfaceObject *acad "Shell.Application")
       fDir (vlax-invoke-method Shell 'BrowseForFolder
              (vla-get-HWND *acad) "Välj mapp där Ritdeffarna finns: " 0))
 (and (eq (type Shell) 'VLA-OBJECT)
      (not (vlax-object-released-p Shell))
      (vl-catch-all-apply
        'vlax-release-object (list Shell)))
 (if fDir
   (progn
     (setq Dir
       (vlax-get-property
         (vlax-get-property fDir 'Self) 'Path))
     (if (not (eq "\\" (substr Dir (strlen Dir))))
       (setq Dir (strcat Dir "\\")))
            (setq dbx
              (vlax-create-object
                (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
                  "ObjectDBX.AxDbDocument"
                  (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))       
     
     (princ "\nProcessing...")
     ;; Iterate Drawings
     
     (foreach dwg (setq dwLst
                    (mapcar
                      (function
                        (lambda (x)
                          (strcat Dir x)))
                      (vl-directory-files Dir "*.dwg" 1)))
              (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply 'vla-open (list dbx dwg)))
  );not
         (progn
(vlax-for lay (vla-get-Layouts dbx)
             (vlax-for Obj (vla-get-Block lay)
           (if (and (eq (vla-get-ObjectName Obj) "AcDbBlockReference")
                    (eq (vla-get-Name Obj) blkNme)
      );and
               (foreach Att (vlax-safearray->list
                              (vlax-variant-value
                                (vla-getAttributes Obj)) )
                 (if (setq Tag (assoc (vla-get-TagString Att) attlst))
                   (vla-put-TextString Att (cdr Tag))
     );if
   );foreach
      );if
    );vlax-for Obj
  );vlax-for lay
       (vla-saveas dbx dwg));progn
       
  );if
;;; (vla-saveas dbx dwg)
       (princ (chr 46))
);foreach
     (princ (strcat "\n<< " (rtos (length dwLst) 2 0) " Drawings Processed >>")))
   (princ "*Cancel*")))
   (princ "\n<< No Blocks Found >>"))
 ;; Garbage Collection
 
 (ObjRel (list Shell dbx *acad))
 (gc)
 (mapcar 'setvar vl ov)
 (princ))
;; Release Objects ~ Requires List of Variables
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

[Lee Mac]

Bear in mind that this doesn't check for drawings that are already opened in the drawing session.

 

I think the best way you are going to achieve this is to use a different method of input, - instead of ATTEDIT.

[au-s]

Seems to be working with _.ddedit. Have tested now on several drawings several times and it is working for now ...

[Lee Mac]

Seems to be working with _.ddedit. Have tested now on several drawings several times and it is working for now ...

 

Excellent.

[daveyboyd]

I have a use for this routine but I also need to add an attribute, can this be done and if so could you tell me how?

 

Thanks

 

Dave

[otil]

A blessed day to everybody. I have the same problem on how to auto edits simaultaeously of titleblock attribute multiple sheets. Usually we are editings hundreds of drawing in the attribute template just to change and update the same entry like rev#,date.... etc what we are struggles is how to less our time and make it eassier. truly is a bloody works for us. anyone who can able to share any software regarding on this. I am not familiar on making programming or script, You can reach me you my email add angelalmendras@yahoo.com. Need help- LITo

[otil]

A blessed day to everybody. I have the same problem on how to auto edits simaultaeously of titleblock attribute multiple sheets. Usually we are editings hundreds of drawing in the attribute template just to change and update the same entry like rev#,date.... etc what we are struggles is how to less our time and make it eassier. truly is a bloody works for us. anyone who can able to share any software regarding on this. I am not familiar on making programming or script, You can reach me you my email add angelalmendras@yahoo.com. Need help- LITo

[Lee Mac]

I could help, but I think its best if we keep it to the forums, so that other members can benefit.

[otil]

i TRY THIS MACATT BUT PROBLEM APPEARS IS > WHAT IS THAT?, ANY MODIFICATION SHOULD BE DONE TO WORK IT. ANYWAY IT WILL WORK ON AUTOCADD 2007? PLEASE HELP ME

[Lee Mac]

Does this work for you?

 

;; Global Attribute Changer
;; Copyright (c) Lee McDonnell 11.06.2009
;; Credit to Tony Tanzillo, Tim Willey.

(defun c:MacAtt  (/ *error* Blk Att Attlst Val Shell fDir Dir acVer dbx dwLst Tag)
 (vl-load-com)

 ;; Error Handler

 (defun *error*  (e)
   (ObjRel (list Shell dbx *acad))
   (if (not (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " e " >>")))
   (princ))

 ;; Get Block

 (while
   (progn
     (setq Blk (getstring t "\nSpecify Block Name: "))
     (cond ((eq "" Blk) t)
           ((snvalid Blk) nil)
           (t (princ "\n** Invalid Block Name **")))))

 ;; Get Attribute List

 (if Blk
   (progn
     (setq blk (strcase blk))

 ; get Att

     (while
       (progn
         (setq Att (getstring
                     (strcat "\nSpecify Tag in Block: " Blk
                             " for Att Change [* to List] <Exit>: ")))
         (cond ((eq "" Att) nil)
               ((eq (chr 42) Att)
                (princ (strcat "\n   " (Pad "Tag" 46 30) "Value"))
                (if Attlst
                  (foreach x  Attlst
                    (princ (strcat "\n" (Pad (car x) 46 30) (cdr x))))
                  (princ "\n   -- None --")))
               ((snvalid Att)
                (setq  Val (getstring t
                             (strcat "\nSpecify New Attribute Value for Tag: " Att " : ")))
                (setq Attlst (cons (cons (strcase Att) Val) Attlst)))
               (t (princ "\n** Invalid Attribute Tag **")))))

     (if Attlst
       (progn

         ;; Get Directory

         (setq *acad (vlax-get-acad-object)
               Shell (vla-getInterfaceObject *acad "Shell.Application")
               fDir  (vlax-invoke-method Shell 'BrowseForFolder
                       (vla-get-HWND *acad) "Select Directory: " 0))
         (if fDir
           (progn
             (setq Dir
                    (vlax-get-property
                      (vlax-get-property fDir 'Self) 'Path))
             (if (not (eq "\\" (substr Dir (strlen Dir))))
               (setq Dir (strcat Dir "\\")))
             (princ "\nProcessing...")

             ;; Iterate Drawings

             (foreach dwg  (setq dwLst
                                  (mapcar
                                    (function
                                      (lambda (x)
                                        (strcat Dir x)))
                                    (vl-directory-files Dir "*.dwg" 1)))

               (vlax-for doc (vla-get-Documents *acad)
                 (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
                      (setq dbx doc)))

               (and (not dbx)
                    (setq dbx
                      (vlax-create-object
                        (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
                          "ObjectDBX.AxDbDocument"
                          (strcat "ObjectDBX.AxDbDocument." (itoa acVer))))))

               (if (not (vl-catch-all-error-p
                          (vl-catch-all-apply 'vla-open (list dbx dwg))))

                 (progn

                   (vlax-for lay  (vla-get-Layouts dbx)
                     (vlax-for Obj  (vla-get-Block lay)
                       (if (and (eq (vla-get-ObjectName Obj) "AcDbBlockReference")
                                (eq (strcase (vla-get-Name Obj)) blk))
                         (foreach Att  (vlax-safearray->list
                                         (vlax-variant-value
                                           (vla-getAttributes Obj)))
                           (if (setq Tag (assoc (strcase (vla-get-TagString Att)) attlst))
                             (vla-put-TextString Att (cdr Tag)))))))

               (vla-saveas dbx dwg)))
               (princ (chr 46)))
             (princ (strcat "\n<< " (rtos (length dwLst) 2 0) " Drawings Processed >>")))
           (princ "*Cancel*")))
       (princ "\n<< No Attributes Specified >>")))
   (princ "\n<< No Block Specified >>"))

 ;; Garbage Collection

 (ObjRel (list Shell dbx *acad))
 (gc)
 (princ))

;; Release Objects ~ Requires List of Variables

(defun ObjRel  (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object
           (list x)))))
   lst))

;; Text Padder

(defun Pad  (Str Chc Len)
 (while (< (strlen Str) Len)
   (setq Str (strcat Str (chr Chc))))
 Str)

[otil]

oK! AFTER SO MAY ATTEMPT IT WORK ON MY SYSTEM BUT THE PROBLEM IS THE TEXT IS NOT ALLIGNED FOR THE FOLLOWING SHEETS, BUT IT YOU DOUBLE CLICK THE THE WILL ALLIGNED SO NEED A LIITLE IMPROVEMENT. THANKS A LOTS

[Lee Mac]

I do not know what would cause the text to not be aligned, I am only substituting the text strings.

[otil]

I do not know what would cause the text to not be aligned, I am only substituting the text strings.

 

 

I send to you the sample drawings regarding the problem of text misallignedPROBLEM.dwg. this all hapenned in the following sheets

[rarmstrong]

Hello

 

If I understood the request, here is attached a lisp (french) that changes the value of an attribute of all the drawings in a directory.

 

The idea is to open a drawing, select the attribute in question, then the directory to be processed and the lisp works for you.

 

@+

hey there ...first time using this site.....I saved the pat.zip file to my computer...am really interested in getting this working, but am having problems opening it. Is the pat.lsp locked or can I look at the code. If it is locked how to you get it into AutoCAD LT 2007...thanks all

[Lee Mac]

Please note that LISP cannot be used in LT without the use of a LISP Extender.

[rarmstrong]

good to know.....I will search for LISP Extender. Thanks for quick response Lee Mac

[rarmstrong]

Hi Lee Mac...I tried your .lsp and it works great! Can this attribute change be done to multiple drawings at once. Pat's logic is in French and I'm getting errors so it doesn't make too much sense to me. Thanks in advance!

[rarmstrong]

Hey Ted...did you get Lee Mac's attribute text script working with multiple drawings at one time....and if so how???? Thanks in advance...I posted this question to Lee Mac as well, but knew you had a look at this as well. Thanks for your knowledge!!!

 

Cheers

R

 

 

 

Lee Mac, your lisp works great!

Thank you so much!

This may be used by so many engineering groups, it saves a large amount of drafting time.

 

If you ever want to visit Vancouver in Canada write me an email at teibrich@shaw.ca.

 

Thanks again,

Ted

[Lee Mac]

My LISP is not engineered to work on multiple drawings - this requires ObjectDBX.

[DomeBoy1984]

Hi,

 

I have just had a read through the previous post on this topic and have found it very helpful. However as I am quite new to using lisps and have no experience of creating any, I was looking for some help. I have a very similar problem to t357. We have a large contract with over 300 drawings to update the title block. The problem is the title block tags i need to edit are both unnamed as '-'. We currently use multibatch usually to batch change drawings. Any help would very much appreciated.

 

Cheers