Update title block attributes in multiple drawings

June 11, 2009

www.74mph.com

'Hurricane' for AutoCAD.

OP post results if you are successful

Z

June 11, 2009

http://discussion.autodesk.com/forums/message.jspa?messageID=6064025

there is something

June 11, 2009

http://discussion.autodesk.com/forums/message.jspa?messageID=6064025

there is something

That seems to be in accordance with my code

June 11, 2009

I run it and what it does it gives me an error but iot averrites every attribute ...

So if I only choose to change one attribute in the block it changes that plus all other..

So if I want to change date in all drawings it changes everything else ..

thats not that good

June 11, 2009

I run it and what it does it gives me an error but iot averrites every attribute ...
So if I only choose to change one attribute in the block it changes that plus all other..

So if I want to change date in all drawings it changes everything else ..

thats not that good

Yes, I set it to collect every attribute from the selected Block.

Because you really want to use the ATTEDIT dialog box to edit the attributes, I will have to set it to compare the attributes before and after Editing to look for differences.

June 11, 2009

I think I might buy you a beer later on

June 11, 2009

I think I might buy you a beer later on

Thanks - but I am still perplexed as to why are you still receiving the error and yet the attributes are being updated.

June 11, 2009

It seems to update it all but I get the error message still.

Tried that now three times

June 11, 2009

Try this, it will compare the attributes before and after you have edited them, and, if an attribute has not been changed it will not update it in all drawings:

;; 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) "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 "\\")))
     (if (< (atoi (setq acVer (substr (getvar "ACADVER") 1 2))) 16)
       (setq acVer "") (setq acVer (strcat (chr 46) acVer)))
     (setq dbx (vla-getInterfaceObject
                 *acad (strcat "ObjectDBX.AxDbDocument" acVer)))
     (princ "\nProcessing...")

     ;; Iterate Drawings
     
     (foreach dwg (setq dwLst
                    (mapcar
                      (function
                        (lambda (x)
                          (strcat Dir x)))
                      (vl-directory-files Dir "*.dwg" 1)))
       (vla-open dbx dwg)

       (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))
               (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)))))))
       
       (vla-saveas dbx dwg)
       (princ (chr 46)))
     (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))

June 12, 2009

Hi,

Well ... it works okej and it's quick allthough it doesn't process that much. And the error is the same...

Strange... I will look for Automation Error. Description was not provided.

What I have in the office here is that AutoCAD is installed in :

C:\CAD\AutoCAD2008

and ADT in C:\CAD\ADT2008 ...

where all dbx files are located ...

Can it be something to do with the path here?

Something to do with ActiveX?

I have got this one ...

;;;************************************************************************
;;; Filename: DBX-DwgScan.LSP
;;; Author:   David Stein
;;; Date:     April 2002
;;; Purpose:  ObjectDBX Drawing Scan Example for Visual LISP Developers Bible book
;;; Copyright (C)2002 David M. Stein, All Rights Reserved.
;;;************************************************************************
;;; Usage: (DWGSCAN tablename itemname drawings)
;;;
;;; Where:
;;;        tablename = string name of table (ex. Blocks, Ltypes, DimStyles, etc.)
;;;        itemname  = string name of item to search for
;;;        drawings  = list of drawing filenames (full paths included for each)
;;;
;;; Returns: A list of filenames that contain the itemname being searched for.
;;;************************************************************************
;;; For use with AutoCAD 2000, 2000i and 2002 or related vertical products
;;; only.  Will NOT work with R14, any LT or Inventor products.
;;; Must be compiled as a separate-namespace VLX application
;;;************************************************************************
(vl-doc-export 'dwgscan)
(vl-load-com)
(defun DLLRegister (dll)
(startapp "regsvr32.exe" (strcat "/s \"" dll "\""))
)
(defun ProgID->ClassID (ProgID)
(vl-registry-read
 (strcat "HKEY_CLASSES_ROOT\\" progid "[url="file://\\CLSID"]\\CLSID[/url]")
)
)
(defun DBX-Register ( / classname)
(setq classname "ObjectDBX.AxDbDocument")
(cond
 ( (ProgID->ClassID classname) )
 ( (and
   (setq server (findfile "AxDb.dll"))
   (DLLRegister server)
   (ProgID->ClassID classname)
  )
   (ProgID->ClassID classname)
 )
 ( (not (setq server (findfile "AxDb.dll")))
   (alert "Error: Cannot locate ObjectDBX Type Library (AxDb.dll)...")
 )
 ( T
   (DLLRegister "ObjectDBX.AxDbDocument")
   (or
   (ProgID->ClassID "ObjectDBX.AxDbDocument")
   (alert "Error: Failed to register ObjectDBX ActiveX services...")
  )
 )
)
)
(defun DBX-GetTableList
(filename tblname / dbxdoc out name)
(cond
 ( (findfile filename)
   (if (not (DBX-Register))
   (vl-exit-with-error "\nUnable to register ObjectDBX from Visual LISP.")
  )
   (setq dbxdoc
   (vla-GetInterfaceObject
    (vlax-get-acad-object)
    "ObjectDBX.AxDbDocument"
   )
  )
   (cond
   ( (vl-catch-all-error-p
     (vl-catch-all-apply
      'vla-Open
      (list
       dbxdoc
       (findfile filename)
      )
     )
    )
     (princ (strcat "\nUnable to open drawing: " filename))
   )
   ( T
     (vlax-For tblItem (DBX-TableGet tblName dbxdoc)
     (setq name (vla-get-Name tblItem))
     (if (/= (substr name 1 1) "*")
      (setq out
       (cons name out)
      )
     )
    )
   )
  ); cond
   (vlax-release-object dbxdoc)
 )
 ( T
   (strcat (princ "\nUnable to open file: " filename))
 )
); cond
(if out (reverse out))
)
(defun DBX-TableGet (tName object)
(cond
 ( (= (strcase tName) "BLOCKS")     (vla-get-Blocks     object) )
 ( (= (strcase tName) "LAYERS")     (vla-get-Layers     object) )
 ( (= (strcase tName) "TEXTSTYLES") (vla-get-textstyles object) )
 ( (= (strcase tName) "DIMSTYLES")  (vla-get-dimstyles  object) )
 ( (= (strcase tName) "LINETYPES")  (vla-get-linetypes  object) )
 ( (or
   (= (strcase tName) "PLOTCONFIGURATIONS")
   (= (strcase tName) "PAGESETUPS")
  )
   (vla-get-plotconfigurations object)
 )
 ( (= (strcase tName) "LAYOUTS") (vla-get-Layouts object) )
 ( (= (strcase tName) "GROUPS")  (vla-get-Groups  object) )
 ( T
   (vl-exit-with-error "\n(dbx-dwgscan error): Invalid table name specified.")
 )
)
)
(defun DWGSCAN
($table $name $dwgfiles / $files $dwgs $path $collection n out)
(cond
 ( (and $table $name $dwgfiles)
   (princ
   (strcat
    "\nScanning "
    (itoa (length $dwgfiles))
     " drawings for "
    (strcase (substr $table 1 (1- (strlen $table))) t)
    " [" $name "]..."
   )
  )
   (foreach n $dwgfiles
   (cond
    ( (setq $collection (DBX-GetTableList n $table))
      (cond
      ( (member (strcase $name) (mapcar 'strcase $collection))
        (setq out (cons n out))
      )
     )
      (setq $collection nil)
    )
    ;( T (princ "\nUnable to query table collection in target drawing.") )
   )
  )
 )
 ( T (princ "\nUsage: (DWGSCAN tablename itemname drawingfiles)"))
)
(if out (reverse out))
)
(princ)
(DBX-Register)
(DLLRegister)
(DBX-TableGet)

When I ruin it ... it says :

Error: Failed to Register ObjectDBX ActiveX services

June 12, 2009

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.

@+

Patrick routine works brilliant ingenious but is there any way to change say 6 attributes at the same time.

June 12, 2009

the zip is corrupt ..

cant be opened

June 15, 2009

Hello LeeMac, I was takign a look at your code for Global Att Extractor and that works fine with Excel and all ...

I tried to modify this code and now I get that :

Command: MacAtt

Select Block or [Name]:

Processing...

>

I use ADT 2008 and ACAD 2008

What I have changed is marked in red

;; 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)       
;; test


 ;; 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) "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 "\\")))
;;;      (if (< (atoi (setq acVer (substr (getvar "ACADVER") 1 2))) 16)
;;;        (setq acVer "") (setq acVer (strcat (chr 46) acVer)))
;;;      (setq dbx (vla-getInterfaceObject
;;;                  *acad (strcat "ObjectDBX.AxDbDocument" acVer)))
     (princ "\nProcessing...")
;;;      (setq dbx
;;;               (vlax-create-object
;;;                 (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
;;;                   "ObjectDBX.AxDbDocument"
;;;                   (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))
[color=red](defun GetDBXInterface (/ Vers)[/color]
[color=red] (cond  ;  ACAD 2010 ??[/color]
[color=red]  ((>= (setq Vers (substr (getvar "acadver") 1 4)) "17.2")[/color]
[color=red]   (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.17"))[/color]
[color=red]  ((< (setq Vers (substr (getvar "acadver") 1 2)) "16")[/color]
[color=red]   (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument"))[/color]
[color=red]  (t[/color]
[color=red]   (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16"))[/color]
[color=red] )[/color]
[color=red])[/color]
;;;      (defun KDUB:GetDBXInterface (/ Vers)
;;;  (if (< (setq Vers (substr (getvar "acadver") 1 4)) "17")
;;;    (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
;;;    (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." Vers))
;;;  )
;;
    [color=red](setq dbx (GetDBXInterface))[/color]
     ;; Iterate Drawings

     (foreach dwg (setq dwLst
                    (mapcar
                      (function
                        (lambda (x)
                          (strcat Dir x)))
                      (vl-directory-files Dir "*.dwg" 1)))
;;; (vla-open dbx dwg)
[color=red](if (not (vl-catch-all-error-p[/color]
[color=red]                   (vl-catch-all-apply 'vla-open (list dbx dwg))))[/color]
[color=red]         (progn[/color]

       (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))
               (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[color=red])))))))))[/color]
       
       (vla-saveas dbx dwg)
       (princ (chr 46)))
     (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))
;;endtest

June 15, 2009

Patrick routine works brilliant ingenious but is there any way to change say 6 attributes at the same time.

Yes you can, but we must adapt the routine.

Not any time.

@+

June 15, 2009

the zip is corrupt ..
cant be opened

The zip work for me.

It was done with winzip v10

@+

June 15, 2009

Hello LeeMac, I was takign a look at your code for Global Att Extractor and that works fine with Excel and all ...

I tried to modify this code and now I get that :

Command: MacAtt

Select Block or [Name]:

Processing...

>

I use ADT 2008 and ACAD 2008

I take it you got the code from theSwamp.org?

Did you look at the latest version that i posted on here (and on there)?

June 15, 2009

yes sure .. I tried some combinations with the same results .. I tried your latest as well.

The code at TheSwamp.org worked fine ... (as a whole code)

June 15, 2009

yes sure .. I tried some combinations with the same results .. I tried your latest as well.
The code at TheSwamp.org worked fine ... (as a whole code)

The Error you posted stems from the creation of the ObjectDBX document - if my code as posted at the Swamp works for you, then the ObjectDBX section should be applicable for this code.

June 15, 2009

Yes, Im trying to remove the excel section and merge those two codes

June 15, 2009

Managed with this code...

Allthough now it updates all the attribute tags ...

AND it gives me an ACAD message after using it twice as:

"Error writing/closing file"

???

;; 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 doc)
 (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)       
;; test


 ;; 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) "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 "\\")))
;;;      (if (< (atoi (setq acVer (substr (getvar "ACADVER") 1 2))) 16)
;;;        (setq acVer "") (setq acVer (strcat (chr 46) acVer)))
;;;      (setq dbx (vla-getInterfaceObject
;;;                  *acad (strcat "ObjectDBX.AxDbDocument" acVer)))
;;;      (defun GetDBXInterface (/ Vers)
;;;  (cond  ;  ACAD 2010 ??
;;;   ((>= (setq Vers (substr (getvar "acadver") 1 4)) "17.2")
;;;    (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.17"))
;;;   ((< (setq Vers (substr (getvar "acadver") 1 2)) "16")
;;;    (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument"))
;;;   (t
;;;    (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16"))
;;;  )
;;
;;;(setq dbx (GetDBXInterface))

     ;; Iterate Drawings


;;;(setq dbx
;;;               (vlax-create-object
;;;                 (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
;;;                   "ObjectDBX.AxDbDocument"
;;;                   (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))      
     (princ "\nProcessing...")

(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 (vla-get-Name Obj) blkNme))
               (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)))))))))

       (vla-saveas dbx dwg)
       (princ (chr 46)))
     (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))
;;endtest

Sign In

Update title block attributes in multiple drawings

Recommended Posts

Zorg

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

au-s

Lee Mac

au-s

Lee Mac

au-s

Lee Mac

au-s

Lee Mac

au-s

gerryhayden@estams.com

au-s

au-s

Patrick_35

Patrick_35

Lee Mac

au-s

Lee Mac

au-s

au-s

Join the conversation

Tutorials

Forums

Activity