Jump to content

Lisp or Script to populate next Revision attributes in Title Block


Billy Ray

Recommended Posts

Hello,

 

This is my first post and I've found much help here over the years. I'm using AutoCAD 2017 and have a title block named "PLC_Anadarko_D_Bord_2017" which is always inserted 0,0 and is on one Layout Tab per DWG. I am trying to edit or find a lisp routine that will look for the most recent Revision info (six columns and six rows of attributes total) Rev #, Date, Drawn By, Description, Checked and Approved. Those Attribute names are below in " " and I am attaching the TB DWG as well.

 

Revision #: "REV0" = 0 or 6, "REV1" = 1 or 7, etc. .... up to "REV6" = 5 or 11

Rev Date: "DATE0" = 0 or 6, etc .... up to "DATE6" = 5 or 11

Drawn By: "IN10" = BRS (

Rev Description: "DESCRIPTION0" = 0 or 6 (

Checked By: "IN20" = 0 or 6 etc. .... up to "IN25" = 5 or 11

Approved By: "IN30" = 0 or 6 etc. ..... up to "IN35" = 5 or 11

 

I have used Lee Macs Update Title Block (CSV) and it is very useful but time consuming with the Structure of my employer. I also like his MAcAttEdit Lisp but these Rev's won't always be the same #. That being said, I am writing a batch file and all that is missing is a Lisp (or command in a script of said lisp) to Populate the next six revision attributes and if it Revs past Rev 5 then replace the first line of attributes with 6 and so on until Rev 11.

Hope I explained enough and thanks for any and all help. I've tried editing some old Lisp routines but I'm terrible at it.

SA8096FA2006PLCE020140901-3.dwg

Link to comment
Share on other sites

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • Billy Ray

    14

  • rlx

    7

  • BIGAL

    2

  • SLW210

    1

Top Posters In This Topic

Trying to edit ADDREVS lisp from Henry F. to accomplish this but not sure if I edited it correctly.

 

;;;Updates revision block named "PLC_Anadarko_D_Bord_2017" containing attributes tagged "REV0", "DESCRIPTION0", "DATE0", "IN10" where # represents numbers 1-8
;;;A block matching these minimal requirements is all that is required.  Formatting, position, etc. may be whatever you may require for your block.
;;;
;;;Command line input: ADDREVS
;;;Script and lisp use: (addrevs <symb> <desc> <date> <by>)
;;;
;;;	Author:	Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;		http://paracadd.com
;;;		All rights reserved.
;;;
;;;		COPYRIGHT: 1/23/09
;;;		   EDITED: 1/23/09
;;;
;;;
(DEFUN c:addrevs (/)
 (SETQ revblock_ss (SSGET "x" (LIST (CONS 0 "insert") (CONS 2 "PLC_Anadarko_D_Bord_2017") (CONS 410 (GETVAR "CTAB")))))
 (IF revblock_ss
   (PROGN
     (setrevs)
     (adrevcore)
   ) ;_ end of PROGN
   (PROGN
     (c:svlayr)
     (setq mjrg "G" llt "-" prod "TTLB" colr "1" modf "REVS")
     (c:mklayr)
     (SETQ old_attreq (GETVAR "ATTREQ"))
     (SETQ old_attdia (GETVAR "ATTDIA"))
     (SETVAR "attreq" 0)
     (SETVAR "attdia" 0)
     (setq mpb "0,0")
     (command ".insert" "PLC_Anadarko_D_Bord_2017" mpb 1.0 1.0 0)
     (SETVAR "attreq" old_attreq)
     (SETVAR "attdia" old_attdia)
     (SETQ revblock_ss (SSGET "x" '((0 . "insert") (2 . "PLC_Anadarko_D_Bord_2017"))))
     (IF revblock_ss
       (PROGN
         (setq this_ent NIL
               revs_lst NIL
         )
         (setrevs)
         (adrevcore)
       )
     )
   )
 ) ;_ end of if
 (PRINC)
) ;_ end of defun
(DEFUN setrevs ()
 (IF ustr
   nil
   (LOAD "ustr" "\nFile USTR.LSP not loaded! ")
 ) ;_ end of IF
 (SETQ new_symb (ustr 0
                      "Revision symbol"
                      (IF new_symb
                        new_symb
                        ""
                      ) ;_ end of if
                      T
                ) ;_ end of ustr
       new_desc (ustr 0
                      "Revision description"
                      (IF new_desc
                        new_desc
                        ""
                      ) ;_ end of if
                      T
                ) ;_ end of ustr
       new_date (ustr 0
                      "Revision date"
                      (IF new_date
                        new_date
                        ""
                      ) ;_ end of if
                      T
                ) ;_ end of ustr
       new_by   (ustr 0
                      "Revision by"
                      (IF new_by
                        new_by
                        ""
                      ) ;_ end of if
                      T
                ) ;_ end of ustr
 ) ;_ end of SETQ
) ;_ end of DEFUN
(DEFUN addrevs (new_symb new_desc new_date new_by / );revblock_ss this_ent revs_lst
 (SETQ revblock_ss (SSGET "x" (LIST (CONS 0 "insert") (CONS 2 "PLC_Anadarko_D_Bord_2017") (CONS 410 (GETVAR "CTAB")))))
 (IF revblock_ss
   (adrevcore)
   (PROGN
     (c:svlayr)
     (setq mjrg "G" llt "-" prod "TTLB" colr "1" modf "REVS")
     (c:mklayr)
     (SETQ old_attreq (GETVAR "ATTREQ"))
     (SETQ old_attdia (GETVAR "ATTDIA"))
     (SETVAR "attreq" 0)
     (SETVAR "attdia" 0)
     (setq mpb "0,0")
     (command ".insert" "PLC_Anadarko_D_Bord_2017" mpb 1.0 1.0 0)
     (SETVAR "attreq" old_attreq)
     (SETVAR "attdia" old_attdia)
     (SETQ revblock_ss (SSGET "x" '((0 . "insert") (2 . "PLC_Anadarko_D_Bord_2017"))))
     (IF revblock_ss
       (PROGN
         (setq this_ent NIL
               revs_lst NIL
         )
         (adrevcore)
       )
     )
   )
 ) ;_ end of if
 (PRINC)
) ;_ end of defun
(DEFUN adrevcore ()
     (SETQ this_ent (ENTGET (SSNAME revblock_ss 0))
           revs_lst NIL
     ) ;_ end of setq
     (WHILE (/= (CDR (ASSOC 0 this_ent)) "SEQEND")
       (IF (WCMATCH (CDR (ASSOC 2 this_ent)) "REV_#*")
         (PROGN
           (SETQ revs_lst (APPEND revs_lst
                                  (LIST (CONS (CDR (ASSOC 2 this_ent))
                                              (LIST (CDR (ASSOC -1 this_ent))
                                                    (CDR (ASSOC 1 this_ent))
                                              ) ;_ end of LIST
                                        ) ;_ end of CONS
                                  ) ;_ end of LIST
                          ) ;_ end of APPEND
           ) ;_ end of setq
         ) ;_ end of PROGN
       ) ;_ end of IF
       (SETQ this_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ent)))))
     ) ;_ end of while
     (COND
       ((OR
          (WCMATCH (LAST (ASSOC "DATE2" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN12" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION2" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV2" revs_lst)) "*?*")
        ) ;_ end of OR
        (ALERT
          "There are no more revision fields available in this block!"
        ) ;_ end of ALERT
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE1" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN11" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION1" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV1" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE1" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN11" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION1" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV1" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE2"
                   rev_by   "IN12"
                   rev_desc "DESCRIPTION2"
                   rev_0 "REV2"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE0" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN10" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION0" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV0" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE0" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN10" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION0" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV0" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE1"
                   rev_by   "IN11"
                   rev_desc "DESCRIPTION1"
                   rev_0 "REV1"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE4" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN14" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION4" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV4" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE4" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN14" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION4" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV4" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE0"
                   rev_by   "IN10"
                   rev_desc "DESCRIPTION0"
                   rev_0 "REV0"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE3" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN13" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION3" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV3" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE3" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN13" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION3" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV3" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE4"
                   rev_by   "IN14"
                   rev_desc "DESCRIPTION4"
                   rev_0 "REV4"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE2" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN11" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION2" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV2" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE2" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN11" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION2" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV2" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE3"
                   rev_by   "IN13"
                   rev_desc "DESCRIPTION3"
                   rev_0 "REV3"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE1" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN11" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION1" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV1" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE1" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN11" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION1" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV1" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE2"
                   rev_by   "IN12"
                   rev_desc "DESCRIPTION2"
                   rev_0 "REV2"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       ((OR
          (WCMATCH (LAST (ASSOC "DATE0" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "IN10" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "DESCRIPTION0" revs_lst)) "*?*")
          (WCMATCH (LAST (ASSOC "REV0" revs_lst)) "*?*")
        ) ;_ end of OR
        (IF
          (AND
            (WCMATCH (LAST (ASSOC "DATE0" revs_lst)) new_date)
            (WCMATCH (LAST (ASSOC "IN10" revs_lst)) new_by)
            (WCMATCH (LAST (ASSOC "DESCRIPTION0" revs_lst)) new_desc)
            (WCMATCH (LAST (ASSOC "REV0" revs_lst)) new_symb)
          ) ;_ end of AND
           NIL
           (PROGN
             (SETQ rev_date "DATE1"
                   rev_by   "IN11"
                   rev_desc "DESCRIPTION1"
                   rev_0 "REV1"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
        ) ;_ end of IF
       )
       (T
           (PROGN
             (SETQ rev_date "DATE0"
                   rev_by   "IN10"
                   rev_desc "DESCRIPTION0"
                   rev_0 "REV0"
             ) ;_ end of SETQ
             (modrevents)
           ) ;_ end of PROGN
       )
     ) ;_ end of COND
)
(DEFUN modrevents ()
 (SETQ new_date_ent (ENTGET (CADR (ASSOC rev_date revs_lst)))
       new_by_ent   (ENTGET (CADR (ASSOC rev_by revs_lst)))
       new_desc_ent (ENTGET (CADR (ASSOC rev_desc revs_lst)))
       new_symb_ent (ENTGET (CADR (ASSOC rev_0 revs_lst)))
       new_date_ent (SUBST (CONS 1 new_date)
                           (ASSOC 1 new_date_ent)
                           new_date_ent
                    ) ;_ end of SUBST
       new_by_ent   (SUBST (CONS 1 new_by) (ASSOC 1 new_by_ent) new_by_ent)
       new_desc_ent (SUBST (CONS 1 new_desc)
                           (ASSOC 1 new_desc_ent)
                           new_desc_ent
                    ) ;_ end of SUBST
       new_symb_ent (SUBST (CONS 1 new_symb)
                           (ASSOC 1 new_symb_ent)
                           new_symb_ent
                    ) ;_ end of SUBST
 ) ;_ end of SETQ
 (ENTMOD new_date_ent)
 (ENTMOD new_by_ent)
 (ENTMOD new_desc_ent)
 (ENTMOD new_symb_ent)
 (ENTUPD (SSNAME revblock_ss 0))
) ;_ end of DEFUN
(PRINC)
;|«Visual LISP© Format Options»
(84 2 40 2 T "end of " 60 9 2 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;

Link to comment
Share on other sites

Its all very doable but you are playing with a lot of attributes. There is a slightly different way to do attribute changes and that is to use their creation order rather than tag name. Using a bit of Vl you getattributes if I remember correct rev0 is the 14th attribute rev1 is 20 and so forth, So you do a quick check for 14 20 26 32 38 etc are not nil meaning it has a rev value

 

 

The easiest way is to make a list of all the attrib values then you can manipulate the list and update the attributes.

 

 

; a rough make a list of attribute
(setq lst '())
(setq obj (vlax-ename->vla-object (car (entsel))))
(foreach att (vlax-invoke obj 'getattributes)
(setq lst (cons (vla-get-textstring att) lst))
)
(princ "\n")
(princ lst)

Link to comment
Share on other sites

SLW210,

 

Thank you for moving the post. I noticed after and was unaware of ow to delete it or move it.

 

BIGAL,

 

Thank you for the response. I am not sure where to insert that code but I will give it a look. REV0 starts at 15, REV1 at 21 and so on. I read one of your post doing this same thing but am unaware of how to write that code. But I will definitely keep trying. Also, a friend of mine is trying to figure out how to accomplish this in .Net. If we find a usable solution I will post it here. I'll try to update the lisp and post if I am successful. Thank y'all again!

Link to comment
Share on other sites

just to give you a start

(defun c:t1 ( / ttbn main-rev pral prul ndate nby ndes nchk napp mrev)
 ; ttbn = titbleblock name , main-rev = tagname main revision attribute
 (setq ttbn "PLC_Anadarko_D_Bord_2017" main-rev  "REV")
 ; project revision attribute list
 (setq pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5"))
 ; project revison update list : date, by, description, checked, approved
 (setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3"))
 ; some test data for new revison
 (setq ndate "06/20/18" nby "RLX" ndes "AS-BUILT" nchk "Billy" napp "Ray")
 (if (and (setq ttb (ssget "x" (list (cons 0 "INSERT")(cons 2 ttbn))))
          (setq ttb (vlax-ename->vla-object (ssname ttb 0))))
   (progn
     (setq mrev (_saval ttb main-rev))
     (setq revidx (vl-position mrev (mapcar '(lambda (a) (_saval ttb a)) pral)))
     (if (or (null revidx) (> revidx 4))
       (setq revidx "0")
       (setq revidx (itoa (1+ revidx)))
     )
     (mapcar '(lambda (tag val) (_caval ttb (strcat tag revidx) val))
              prul
              (list ndate nby ndes nchk napp)
     )
     (setq mrev (itoa (1+ (atoi mrev))))
     (_caval ttb (strcat "REV" revidx) mrev)
     (_caval ttb main-rev mrev)
   )
   (princ "\nNo valid titleblock found")
 )
 (princ)
)

; change attribute value
(defun _caval (blk tag val)
 (vl-some '(lambda (x)
             (if (= (strcase tag) (strcase (vla-get-tagstring x)))
               (progn (vla-put-textstring x val) val)))
           (vlax-invoke blk 'getattributes)
 )
)
; show attribute value
(defun _saval ( blk tag )
 (vl-some '(lambda (x)
             (if (= (strcase tag) (strcase (vla-get-tagstring x)))
               (vla-get-textstring x)))
           (vlax-invoke blk 'getattributes)
 )
)

Link to comment
Share on other sites

Wow! that works immediately. I can't figure out how it knows to go to REV 1 in the code lol, in this case I'd have to make 8 different Lisp and batches but still doable. Hoping I can add Bigal's code with it to make it search for the latest rev and populate the next one not sure how to make it todays date always, maybe (getvar “CDATE”) but it'd have to be in MM/DD/YY format. Still awesome I can't believe how fast y'all are.

Link to comment
Share on other sites

to get a better listing you could use something like :

; show block attributes (tag and value). Returns sorted list or nil
(defun c:t2 ( / b l )
 (if (and (setq b (car (entsel))) (setq b (vlax-ename->vla-object b)) (= (vla-get-HasAttributes b) :vlax-true))
   (setq l (mapcar '(lambda (a)(list (vla-get-tagstring a) (vla-get-textstring a))) (vlax-invoke b 'getattributes))))
 (if l (vl-sort l '(lambda (a b)(< (car a)(car b)))) nil)
)

but basically its the same code as Bigal's code.

 

 

Appie works by first looking at the main revision (attribute "REV") and then it scans all project revisions ("REV0" "REV1"... etc)

If it finds a match it returns the index. If its larger than 4 (it must be 5) index will return to 0 and if no match was found (brand new title block) it also will go to number zero. Else index will be raised by 1 as also the main revision.

 

 

Awel, working day is done so going home now :beer:

 

 

gr. Rlx

Link to comment
Share on other sites

Thanks for helping. I couldn't get that to work but I'm assuming I was supposed to add it some where. Have a good one and thanks anyhow!

Link to comment
Share on other sites

RLX,

 

I'm not sure what changed but the first code you wrote is working perfectly now. I see now it reads off the last digit of the file name as well and misused it. Adding this command in my script with custom field insertions now allows me to auto generate all Revision information. Thank you very much this is amazing! I just need to make the date always current and then I can wrap a bow on it. Y'all are awesome!! Cheers!

Link to comment
Share on other sites

And ..... I forgot about Revision A lol. Need a way to update the lisp so if A is found start at 0, not 1.

 

 

shouldn't be to hard. If main rev is nil or "" (empty) , mrev will be "A" ; if main rev is "A" mrev will be "0" and every other case will be 1+ main rev ; 'cond' function will do nicely ...

Link to comment
Share on other sites

shouldn't be to hard. If main rev is nil or "" (empty) , mrev will be "A" ; if main rev is "A" mrev will be "0" and every other case will be 1+ main rev ; 'cond' function will do nicely ...

 

Easy for you lol not me, but thank you. I can't even figure out how to set today's date in "date". Thanks again though!

Link to comment
Share on other sites

Easy for you lol not me, but thank you. I can't even figure out how to set today's date in "date". Thanks again though!

 

 

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/getvar-quot-date-quot/td-p/814445
(setq date (rtos (getvar "cdate") 2 6) year (substr date 3 2) month (substr date 5 2) day (substr date 7 2))
(setq date (strcat day "-" month "-" year))

Link to comment
Share on other sites

And .... I'm dumb. Not putting it in correctly I'm guessing:

(defun c:ADDREV-AB ( / ttbn main-rev pral prul ndate nby ndes nchk napp mrev)
 ; ttbn = titbleblock name , main-rev = tagname main revision attribute
 (setq ttbn "PLC_Anadarko_D_Bord_2017" main-rev  "REV")
 ; project revision attribute list
 (setq pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5"))
 ; project revison update list : date, by, description, checked, approved
 (setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3"))
 ; some test data for new revison
 [b](setq date (strcat day "-" month "-" year))[/b] nby "BRS" ndes "AS-BUILT" nchk "SC" napp "DEE")
 (if (and (setq ttb (ssget "x" (list (cons 0 "INSERT")(cons 2 ttbn))))
          (setq ttb (vlax-ename->vla-object (ssname ttb 0))))
   (progn
     (setq mrev (_saval ttb main-rev))
     (setq revidx (vl-position mrev (mapcar '(lambda (a) (_saval ttb a)) pral)))
     (if (or (null revidx) (> revidx 4))
       (setq revidx "0")
       (setq revidx (itoa (1+ revidx)))
     )
     (mapcar '(lambda (tag val) (_caval ttb (strcat tag revidx) val))
              prul
              (list ndate nby ndes nchk napp)
     )
     (setq mrev (itoa (1+ (atoi mrev))))
     (_caval ttb (strcat "REV" revidx) mrev)
     (_caval ttb main-rev mrev)
   )
   (princ "\nNo valid titleblock found")
 )
 (princ)
)

; change attribute value
(defun _caval (blk tag val)
 (vl-some '(lambda (x)
             (if (= (strcase tag) (strcase (vla-get-tagstring x)))
               (progn (vla-put-textstring x val) val)))
           (vlax-invoke blk 'getattributes)
 )
)
; show attribute value
(defun _saval ( blk tag )
 (vl-some '(lambda (x)
             (if (= (strcase tag) (strcase (vla-get-tagstring x)))
               (vla-get-textstring x)))
           (vlax-invoke blk 'getattributes)
 )
)

Link to comment
Share on other sites

try this : (code updated and limited tested)

 

 

 

(defun c:ADDREV-AB  (/ ttbn main-rev pral prul date ndate nby ndes nchk napp old-rev revidx year month day new-rev)
 ;;; ttbn = titbleblock name , main-rev = tagname main revision attribute
 (setq ttbn "PLC_Anadarko_D_Bord_2017" main-rev "REV")
 ;;; project revision attribute list
 (setq pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5"))
 ; project revison update list : date, by, description, checked, approved
 (setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3"))
 ;;; some test data for new revison
 (setq date (rtos (getvar "cdate") 2 6) year (substr date 3 2) month (substr date 5 2) day (substr date 7 2))
 (setq ndate (strcat month "/" day "/" year) nby  "BRS" ndes "AS-BUILT" nchk "SC" napp "DEE")
 (if (and (setq ttb (ssget "x" (list (cons 0 "INSERT") (cons 2 ttbn))))
      (setq ttb (vlax-ename->vla-object (ssname ttb 0))))
   (progn
     ;;; first read main revision from attribute "REV"
     (if (member (setq old-rev (_saval ttb main-rev)) '("" " " nil))
   ;;; empty / new titleblock
   (setq revidx "0")
   ;;; else try to match main rev with one of the project revisions
   (progn
     (setq revidx (vl-position old-rev (mapcar '(lambda (a) (_saval ttb a)) pral)))
     ;;; if no match is found or last project revision row is found, default to row zero else next row
     (if (or (null revidx) (> revidx 4)) (setq revidx "0") (setq revidx (itoa (1+ revidx))))
   )
     )
     (mapcar '(lambda (tag val) (_caval ttb (strcat tag revidx) val)) prul (list ndate nby ndes nchk napp))
     (cond
   ((member old-rev '("" " " nil))(setq new-rev "A"))
   ((eq old-rev "A")(setq new-rev "0"))
   (t (setq new-rev (itoa (1+ (atoi old-rev)))))
     )
     (_caval ttb (strcat "REV" revidx) new-rev)
     (_caval ttb main-rev new-rev)
   )
   (princ "\nNo valid titleblock found")
 )
 (princ)
)


; change attribute value
(defun _caval (blk tag val)
 (vl-some '(lambda (x)
         (if (= (strcase tag) (strcase (vla-get-tagstring x)))
       (progn (vla-put-textstring x val) val)
         )
       )
      (vlax-invoke blk 'getattributes)
 )
)
; show attribute value
(defun _saval (blk tag)
 (vl-some '(lambda (x)
         (if (= (strcase tag) (strcase (vla-get-tagstring x)))
       (vla-get-textstring x)
         )
       )
      (vlax-invoke blk 'getattributes)
 )
)


Edited by rlx
Link to comment
Share on other sites

You're a saint! Thank you sir I really appreciate all of your help. I'll put the code below again in case anyone needs it in the future. Now I have three batch files (with relative script and lisp routines thanks to you) that users can pick from relative to the Revision Description. All one has to do here now is double click and watch it go! Utilizing this with field insertions, etc. all Title Block Data will be auto generated and any simple CAD user can use it. You're the man!

 

Code:

(defun c:ADDREV  (/ ttbn main-rev pral prul ndate nby ndes nchk napp old-rev revidx year month day new-rev)
 ; ttbn = titbleblock name , main-rev = tagname main revision attribute
 (setq    ttbn "Your Title Block Name" main-rev "REV")
 ; project revision attribute list
 (setq pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5"))
 ; project revison update list : date, by, description, checked, approved
 (setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3"))
 ; some test data for new revison
 (setq date (rtos (getvar "cdate") 2 6) year (substr date 3 2) month (substr date 5 2) day (substr date 7 2))
 (setq ndate (strcat month "/" day "/" year) nby  "Drawn By Initials" ndes "Revision Comment" nchk "Check Initials" napp "Approve Initials")
 (if (and (setq ttb (ssget "x" (list (cons 0 "INSERT") (cons 2 ttbn))))
      (setq ttb (vlax-ename->vla-object (ssname ttb 0))))
   (progn
     (setq old-rev (_saval ttb main-rev))
     (setq revidx (vl-position old-rev (mapcar '(lambda (a) (_saval ttb a)) pral)))
     (if (or (null revidx) (> revidx 4))
   (setq revidx "0")
   (setq revidx (itoa (1+ revidx)))
     )
     (mapcar '(lambda (tag val) (_caval ttb (strcat tag revidx) val)) prul (list ndate nby ndes nchk napp))
     (cond
   ((null old-rev)(setq new-rev "A"))
   ((eq old-rev "A")(setq new-rev "0"))
   (t (setq new-rev (itoa (1+ (atoi old-rev)))))
     )
     (_caval ttb (strcat "REV" revidx) new-rev)
     (_caval ttb main-rev new-rev)
   )
   (princ "\nNo valid titleblock found")
 )
 (princ)
)


; change attribute value
(defun _caval (blk tag val)
 (vl-some '(lambda (x)
         (if (= (strcase tag) (strcase (vla-get-tagstring x)))
       (progn (vla-put-textstring x val) val)
         )
       )
      (vlax-invoke blk 'getattributes)
 )
)
; show attribute value
(defun _saval (blk tag)
 (vl-some '(lambda (x)
         (if (= (strcase tag) (strcase (vla-get-tagstring x)))
       (vla-get-textstring x)
         )
       )
      (vlax-invoke blk 'getattributes)
 )
)

Link to comment
Share on other sites

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.


×
×
  • Create New...