LISP Code to Select Block in Layouts and Update Attributes

[Bill Tillman]

I'm working with CAD files which contain a dozen or so layout tabs and each on contains a block which is the title block for the drawing page. This block contains about 10 attributes which I am presently editing by hand. No problem except when I need to update or change the values in these attributes like the date, the customer name, drawing number, etc...

 

So I need advice on how to select the individual layout tab, then select the block and then change the needed attributes. And I need to iterate through all the layout tabs. The code examples I've looked at thus far require the user to select the block. My need is to just open the drawing, then setup the values needed for the attributes and then turn the code loose on the entire drawing file and let it make the changes to the block attributes on each layout tab.

 

So I'm starting out with something like this:

(foreach layout (layoutlist)
   (setvar "ctab" layout)
   )

 

But this is a loaded up drawing file with 19 layout sheets, dozens of layers and blocks. And the code chokes almost immediately. AutoCAD goes into a not responding mode and all that happens is that I end up with the last block in the file as the current layout tab. Okay that's cool I haven't really asked to to grab the title block yet and do anything. But my concerns are will this be a trouble spot as I go through development on this?

[ronjonp]

If you use something like: (sssetfirst nil (ssget "_X" '((0 . "insert") (2 . "nameofyourtitleblock") (66 . 1))))

 

You can update all common attributes within the property palette all at once. No need for cycling through the tabs.

 

Another way to approach this is to setup your titleblock as an xref, then keep all common info within the xref so you only have to make the change once.

[Bill Tillman]

Thanks, that looks cool and I'll be trying it out next. I grabbed a piece of code from LeeMac's site and tried it like so:

(vl-load-com)

(defun C:test ()

 (foreach layout (layoutlist)
   (setvar "ctab" layout)

   (LM:vl-SetAttributeValue "E Titleblock" "DATE" "08/10/17")
   
   )
 )

(defun LM:vl-SetAttributeValue ( blk tag val )
 
   (setq tag (strcase tag))
   (vl-some
       (function
           (lambda ( att )
               (if (= tag (strcase (vla-get-tagstring att)))
                   (progn
                       (vla-put-textstring att val)
                       val
                   )
               )
           )
       )
       (vlax-invoke block 'getattributes)
   )
)

But when this runs I get the error message:

 

Bad argument type:VLA-OBJECT nil

 

LOG Error trace

...............

:ERROR-BREAK

[2] (vlax-invoke nil GETATTRIBUTES)

[3] (LM:VL-SETATTRIBUTEVALUE "E Titleblock" "DATE" "08/10/17")

[4] (FOREACH ...)

[5] (C:TEST)

:CALLBACK-ENTRY

:ARQ-SUBR-CALLBACK

...............

Backtrace is out of date

...............

 

[BIGAL]

Here is another example

 

; update the COGG title blocks in a dwg
; change the 410 to layout name
;;-------------------=={ Parse Numbers }==--------------------;;
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;
(defun LM:ParseNumbers ( s )
 (
   (lambda ( l )
     (read
       (strcat "("
         (vl-list->string
           (mapcar
             (function
               (lambda ( a b c )
                 (if
                   (or
                     (< 47 b 58)
                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
                   )
                   b 32
                 )
               )
             )
             (cons nil l) l (append (cdr l) (list nil))
           )
         )
         ")"
       )
     )
   )
   (vl-string->list s)
 )
)
(defun ah:sheetupdate1 ( / ss1 len lay plotabs tabname dwgname oldtag1 oldtag2 oldtag3 oldtag4 oldtag5)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
 (setq plotabs (cons (vla-get-name lay) plotabs))
)
(IF (NOT AH:getval3)(LOAD "GETVALS"))
(AH:getval3 "Please enter dwg number" 12 9 
"Please enter version for all sheets <Cr> no change" 8 5 
"Please enter line1 details " 40 38
)
(setq dwgname VAL1)
(setq newstr4 VAL2)
(SETQ NEWSTR6 VAL3)

(princ "0")
(setq len (length plotabs))
(setq x 0)
(setq bname "DA1DRTXT")
(repeat len
 (setq tabname (nth x plotabs))
 (if (/= tabname "Model")
   (progn
     (setvar "ctab" tabname)
     (command "pspace")
     (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname)(cons 410 tabname))))
     (setq dwgnum (Lm:parsenumbers tabname))
     (setq sheetnum (car dwgnum))
     (setq oldtag1 "SHT_NO") ;attribute tag name
     (setq newstr1 (rtos sheetnum 2 0))
     (setq oldtag2 "DRG_NO") ;attribute tag name
     (setq oldtag3 "PROJ_NO") ;attribute tag name
     (setq newstr3 dwgname)
     (setq oldtag4 "REV_NO") ;attribute tag name
     (setq oldtag5 "SHEETS") ;attribute tag name
     (setq oldtag6 "STREET") ;attribute tag name

; if less than 10
(if (< (car dwgnum) 10.0) 
     (setq newstr2 (strcat dwgname "-D0"  (rtos sheetnum 2 0)))
     (setq newstr2 (strcat dwgname "-D"  (rtos sheetnum 2 0)))
)
     (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
       (if (= oldtag1 (strcase (vla-get-tagstring att)))
       (vla-put-textstring att newstr1) 
       ) ; end if
       (if (= oldtag2 (strcase (vla-get-tagstring att)))
       (vla-put-textstring att newstr2) 
       ) ; end if
       (if (= oldtag3 (strcase (vla-get-tagstring att)))
       (vla-put-textstring att newstr3) 
       ) ; end if
       (if (and (/= newstr4 nil) (= oldtag4 (strcase (vla-get-tagstring att))) )
       (vla-put-textstring att newstr4) 
       ) ; end if 
       (if (= oldtag5 (strcase (vla-get-tagstring att)))
       (vla-put-textstring att (rtos (- len 1) 2 0)) 
       ) ; end if
(if (= oldtag6 (strcase (vla-get-tagstring att)))
       (vla-put-textstring att newstr6) 
       ) ; end if
      ) ; end foreach
   ) ; end progn
) ; end if
(setq x (+ x 1))
) ; end repeat
(setq ss1 nil)  
) ; end defun ah

(ah:sheetupdate1)
(princ)

 

; Input  Dialog box with variable title
; multiple lines of dcl input supported
; add extra lines if required by copying code defun
; By Alan H 2015
(vl-load-com)
; 1 line dcl
; sample code (ah:getval1 "Line 1" 5 4)
(defun AH:getval1 (title width limit / fo fname)
; you can hard code a directory if you like for dcl file
;(setq fo (open (setq fname "c:\\ACADTEMP\\GETVAL.DCL")) "w"))
setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
(write-line (strcat "     edit_width = " (rtos width 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_only;}" fo)
(close fo)
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key1" 3)
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 as a string
(vl-file-delete fname)
) ; defungetval1
; 2 line dcl
; sample code (ah:getval2 "Line 1" 5 4 "Line2" 8 7)
(defun AH:getval2 (title1 width1 limit1 title2 width2 limit2 / fo fname)
;(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(setq fo (open (setq fname "c:\\ACADTEMP\\GETVAL.DCL")) "w"))
(write-line "ddgetval2 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)
; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval2" dcl_id))
(exit))
(mode_tile "key1" 3)
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(action_tile "key2" "(setq val2 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 and val2 as strings
(vl-file-delete fname)
) ; defungetval2
; 3 line dcl
; sample code (ah:getval3 "Line 1" 5 4 "Line 2" 8 7 "Line 3" 6 4)
(defun AH:getval3 (title1 width1 limit1 title2 width2 limit2 title3 width3 limit3 / fo fname)
;(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(setq fo (open (setq fname "c:\\ACADTEMP\\GETVAL.DCL")) "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)
; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(action_tile "key3" "(setq val3 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 val2 and val3 as strings
(vl-file-delete fname)
) ; defungetval3

[Tharwat]

Hi,

 

Give this a shot.

 

(defun c:Test ( / s i o e )
 ;; Tharwat - Date: 10.Aug.2017		;;
 ;; Update attribute with tag "DATE" in	;;
 ;; all layouts excluding Model Space		;;
 (and (or (setq i -1 s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "E Titleblock")(410 . "~Model"))))
          (alert "No Attributed blocks found with the name <E Titleblock> in Paper Spaces")
          )
    (while (setq o (ssname s (setq i (1+ i))))
      (while (= (cdr (assoc 0 (setq e (entget (setq o (entnext o)))))) "ATTRIB")
        (and (eq (cdr (assoc 2 e)) "DATE")
             (entmod (subst '(1 . "08/10/17") (assoc 1 e) e))
             )
        )
      )
    )
(princ)
)

[mostafa badran]

But when this runs I get the error message:

Maybe this help

(defun c:update (/ DATE INC SS TAG )
 ;m bdran
 (VL-LOAD-COM)
 (setq    cdate_val (rtos (getvar "CDATE") 2 6)
   YYYY      (substr cdate_val 3 2)
   M      (substr cdate_val 5 2)
   D      (substr cdate_val 7 2)
   date      (strcat m "/" d "/" YYYY)
   tag      "DATE:"
 )
(setq ss (ssget "x"  '((0 . "INSERT") (2 . "E Titleblock")(410 . "~Model"))));check block in layout tab
(setq inc (sslength ss))
(repeat    inc
 (foreach att
      (vlax-invoke
        (vlax-ename->vla-object (ssname ss (setq inc (1- inc))))
        'getattributes
      )
   (if    (= tag (strcase (vla-get-tagstring att)))
     (vla-put-textstring att date)
   )
 )
)
 (princ)
)

[Bill Tillman]

Thanks everyone. Thawart's code works really slick and I'm sure the others will too. Will get a chance to test them tomorrow. Down and dirty code to handle those daily chores proves the best solution once again.

 

BTW Tharwat, -I'm so rusty on this but I assume the (1+ i) is to skip passed the model space tab?

[Tharwat]

Thanks everyone. Thawart's code works really slick

 

You are most welcome.

 

BTW Tharwat, -I'm so rusty on this but I assume the (1+ i) is to skip passed the model space tab?

Unfortunately no, but the Tilde symbol which is before Model string in the codes is the one that excludes the Model Space.

[Bill Tillman]

I'd like to use a string variable that I can assign to for this...but when I try

(setq x (strcat (itoa count) " of " (itoa numSheets)))

(and
     (eq (cdr (assoc 2 e)) "SHEETNUMBER")
     (entmod
       (subst '(1 . x) (assoc 1 e) e))
     )

I get a bad DXF error message...?

[Tharwat]

I get a bad DXF error message...?

Since its a variable then you need to construct it with cons in this case.

eg:

(cons 1 x)

[Bill Tillman]

That's the ticket...thanks.

[Tharwat]

That's the ticket...thanks.

 

You're welcome. Happy coding.

[Bill Tillman]

Cool, that takes care of one of the problems...I want to use a variable for the block name too but I'm not getting the same results with that:

(setq    blkname "E Titleblock"
        ss (ssget "x" '((0 . "INSERT") (cons 2  blkname)  (410 . "~Model")))    
   )

Funny, when I run (cons 2 blkname) at the command line it returns

(2 . "E Titleblock")

Edited August 12, 2017 by Bill Tillman

[Tharwat]

You have the same issue as the previous question which means is that you need to replace the quote function with list function in this case.

 

eg:

(list '(0 . "INSERT") (cons 2  blkname)  .....

 

Quote function prevents evaluation but list allows.

[Bill Tillman]

You know they don't call it Lost in Stupid Parenthesis for nothing, I'm using this syntax

(setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkname) (410 . "~Model"))))

but it's still returning bad SSGET list.

 

UPDATE: I found it...it wanted another apostrophe

(setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkname) '(410 . "~Model"))))

[Tharwat]

You know they don't call it Lost in Stupid Parenthesis for nothing,

 

UPDATE: I found it...it wanted another apostrophe

(setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkname) '(410 . "~Model"))))

 

That's correct.

[BIGAL]

if you dont want to mix and match cons with ' this works also.

 

(setq ss (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname)(cons 410 "~Model"))))

[Bill Tillman]

All is working well with this code. But this morning I tried to change another one of the attributes and it's not working so well. The problem is the author of the block built it using the same tag names for more than one attribute. As you can see they called all the stuff related to a particular REV # the same tag name. So when I use the code above I end up with some freaky looking text in the title block. So without changing up the format, how could I go about getting the attribute values changed properly.

Block Attribute Values.pdf

[Tharwat]

You can rectify the attributed block with the command BATTMAN then use the codes that I posted for you in this thread.

[Bill Tillman]

Okay, I'm not sure what happened but this was once working really slick. Especially the count variable which filled in the page and drawing numbers. But suddenly the count variable now works like this, even though when I set the watch window to watch it, it shows up correctly, but it behaves like this:

 

page 1 is correct

page 2 count gets set to 6 so all pages up to page 9 are off by 5

.

it increments correctly by 1 up to page 10 but then resets to 2

.

on page 10 count starts all over again at 2 so all the rest of pages up to page 13 are numbered incorrectly ... ??? I cannot explain why?

 

(defun c:tblock (/ s i o e)
 ;; Update attributes in all layouts excluding Model Space        ;;

 ;;;-----------------------------------------------------------------------------------
 ;;; Enter values for your title block here  
 ;;; ONLY MAKE REVISIONS IN THIS SECTION OF THE CODE
 (setq
   customer  "BT Group LLC"
   project      "Job Name"
   dwgby      "BT"
   scale      "As Noted"
   jobno      "16-0211"
   blkname   "current-amf-36x24-border"
   reva      "Per Arch/GC Notes 0001"    ; description
   reva1     "9/12/17"               ; date
   reva2     "BT"               ; drawn by
   revb      "Per GC Inspections 0002"
   revb1     "9/13/17"
   revb2     "BT"
   revc      "Per PE Comments 0003"
   revc1     "9/14/17"
   revc2     "BT"
   revd      "Final Approval 0004"
   revd1     "9/15/17"
   revd2     "BT"
   )
 ;;; MAKE NO MORE REVISIONS BELOW THIS LINE
 ;;;-----------------------------------------------------------------------------------

 (setq    ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkname) '(410 . "~Model")))
   numSheets (sslength ss)
   count      1
   date      (strcat (substr (rtos (getvar "CDATE") 2 6) 5 2) "/"
             (substr (rtos (getvar "CDATE") 2 6) 7 2) "/"
             (substr (rtos (getvar "CDATE") 2 6) 3 2))
   )
 (and
   (or
     (setq i -1
       s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 blkname) '(410 . "~Model")))
       )
     (alert "No Attributed blocks found with that name in Paper Spaces")
   )
   
   (while (setq o (ssname s (setq i (1+ i))))
     (while (=    (cdr (assoc 0 (setq e (entget (setq o (entnext o))))))
       "ATTRIB"
        )
   (and (eq (cdr (assoc 2 e)) "DATE")
        (entmod (subst (cons 1 date) (assoc 1 e) e))
   )
   (and (eq (cdr (assoc 2 e)) "DWG-BY")
        (entmod (subst (cons 1 dwgby) (assoc 1 e) e))
   )
   (and (eq (cdr (assoc 2 e)) "CUSTNAME")
        (entmod (subst (cons 1 customer) (assoc 1 e) e))
   )
   (and
     (eq (cdr (assoc 2 e)) "PROJECT")
     (entmod (subst (cons 1 project) (assoc 1 e) e)
     )
   )
   (and (eq (cdr (assoc 2 e)) "SCALE")
        (entmod (subst (cons 1 scale) (assoc 1 e) e))
   )

   ;;; This used to work fine but now it gets page 1 correct
   ;;; but then skips to 6 then restarts at 2 again on page 10 ??????
   (and
     (eq (cdr (assoc 2 e)) "SHEETNUMBER")
     (entmod
       (subst (cons 1 (strcat (itoa count) " of " (itoa numSheets))) (assoc 1 e) e))
     )
   ;;;--------------------------------------------------------------------------------
   
   (and
     (eq (cdr (assoc 2 e)) "DWG")
     (entmod
       (subst (cons 1 (strcat jobno "-SD-" (itoa count))) (assoc 1 e) e))
     )

   ;;; REVISIONS
   (and
     (eq (cdr (assoc 2 e)) "REVA")
     (entmod
       (subst (cons 1 REVA) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVA1")
     (entmod
       (subst (cons 1 REVA1) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVA2")
     (entmod
       (subst (cons 1 REVA2) (assoc 1 e) e))
     )

   (and
     (eq (cdr (assoc 2 e)) "REVB")
     (entmod
       (subst (cons 1 REVB) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVB1")
     (entmod
       (subst (cons 1 REVB1) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVB2")
     (entmod
       (subst (cons 1 REVB2) (assoc 1 e) e))
     )

   (and
     (eq (cdr (assoc 2 e)) "REVC")
     (entmod
       (subst (cons 1 REVC) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVC1")
     (entmod
       (subst (cons 1 REVC1) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVC2")
     (entmod
       (subst (cons 1 REVC2) (assoc 1 e) e))
     )

   (and
     (eq (cdr (assoc 2 e)) "REVD")
     (entmod
       (subst (cons 1 REVD) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVD1")
     (entmod
       (subst (cons 1 REVD1) (assoc 1 e) e))
     )
   (and
     (eq (cdr (assoc 2 e)) "REVD2")
     (entmod
       (subst (cons 1 REVD2) (assoc 1 e) e))
     )

   )
     (setq count (1+ count))
     )
   
   )
 (princ)
)

I just copied the previous example and then built on to it from there, so I'm not certain that this format is efficient, even though it does, or at least did work perfectly. Are all the (and's) needed? Could it be done in a more efficient manner? Everything works with the exception of the count variable?