+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 17
  1. #1
    Super Member Bill Tillman's Avatar
    Using
    AutoCAD 2014
    Join Date
    Oct 2008
    Location
    Miami, FL
    Posts
    1,241

    Default LISP Code to Select Block in Layouts and Update Attributes

    Registered forum members do not see this ad.

    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:
    Code:
    (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?
    It's deja vu, all over again.

  2. #2
    Senior Member
    Computer Details
    ronjonp's Computer Details
    Operating System:
    Windows 10
    Using
    AutoCAD 2018
    Join Date
    Apr 2009
    Location
    Colorado
    Posts
    340

    Default

    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.

  3. #3
    Super Member Bill Tillman's Avatar
    Using
    AutoCAD 2014
    Join Date
    Oct 2008
    Location
    Miami, FL
    Posts
    1,241

    Default

    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:
    Code:
    (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
    ...............
    <1> :ERROR-BREAK
    [2] (vlax-invoke nil GETATTRIBUTES)
    [3] (LM:VL-SETATTRIBUTEVALUE "E Titleblock" "DATE" "08/10/17")
    [4] (FOREACH ...)
    [5] (C:TEST)
    <6> :CALLBACK-ENTRY
    <7> :ARQ-SUBR-CALLBACK
    ...............
    Backtrace is out of date
    ...............
    It's deja vu, all over again.

  4. #4
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,508

    Default

    Here is another example

    Code:
    ; 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 - www.lee-mac.com       ;;
    ;;------------------------------------------------------------;;
    ;;  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)
    Code:
    ; 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
    A man who never made mistakes never made anything

  5. #5
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    5,983

    Default

    Hi,

    Give this a shot.

    Code:
    (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)
    )

  6. #6
    Senior Member mostafa badran's Avatar
    Computer Details
    mostafa badran's Computer Details
    Operating System:
    win 7
    Computer:
    Dell
    CPU:
    Core I7
    RAM:
    12 GB
    Graphics:
    2 GB
    Primary Storage:
    350 GB
    Monitor:
    Fujitsu
    Discipline
    Electrical
    mostafa badran's Discipline Details
    Occupation
    Cad Operator
    Discipline
    Electrical
    Details
    Power & low current system.
    Using
    AutoCAD 2014
    Join Date
    May 2010
    Location
    KSA
    Posts
    231

    Default

    Quote Originally Posted by Bill Tillman View Post
    But when this runs I get the error message:
    Maybe this help
    Code:
    (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)
    )
    What doesn't kill you makes you stronger

  7. #7
    Super Member Bill Tillman's Avatar
    Using
    AutoCAD 2014
    Join Date
    Oct 2008
    Location
    Miami, FL
    Posts
    1,241

    Default

    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?
    It's deja vu, all over again.

  8. #8
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    5,983

    Default

    Quote Originally Posted by Bill Tillman View Post
    Thanks everyone. Thawart's code works really slick
    You are most welcome.

    Quote Originally Posted by Bill Tillman View Post
    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.

  9. #9
    Super Member Bill Tillman's Avatar
    Using
    AutoCAD 2014
    Join Date
    Oct 2008
    Location
    Miami, FL
    Posts
    1,241

    Default

    I'd like to use a string variable that I can assign to for this...but when I try
    Code:
    (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...?
    It's deja vu, all over again.

  10. #10
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    5,983

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by Bill Tillman View Post
    I get a bad DXF error message...?
    Since its a variable then you need to construct it with cons in this case.
    eg:
    Code:
    (cons 1 x)

Similar Threads

  1. Lisp routine use csv to update title block attributes
    By honrice in forum AutoLISP, Visual LISP & DCL
    Replies: 3
    Last Post: 8th Mar 2016, 03:27 pm
  2. Copy attributes data block to block different layouts!
    By Greenuser in forum AutoLISP, Visual LISP & DCL
    Replies: 17
    Last Post: 22nd Apr 2015, 09:32 am
  3. Macro or LISP - select all layouts & publish
    By mikekmx in forum AutoCAD General
    Replies: 8
    Last Post: 26th Mar 2014, 02:52 am
  4. Lisp routine use csv to update title block attributes - on ctab
    By HRae in forum AutoLISP, Visual LISP & DCL
    Replies: 116
    Last Post: 16th Feb 2014, 12:06 am
  5. can anyone write me vba code to update attributes in access table
    By vittorio0 in forum AutoLISP, Visual LISP & DCL
    Replies: 0
    Last Post: 19th Jul 2009, 07:51 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts