Add 2 attributes to a Lisp...

[Billy Ray]

     Hello again. I have an amazing Lisp thanks to the help of this forum. It updates attributes in a block (Rev, Date, By, Description, Checked and Approved) and works great! I am hoping to add two more attributes to it that need to be updated with the same values already in the routine. I have not been able to figure out how to do that. The two additional Attribute tag names are "STAMPDESC" and "STAMPDATE" and the values for each are the same as "ndate" (current date) and "ndes" (revision comment) below. I am sure this is simple but I have not been able to add to this routine without messing it up. I left the the titleblock name and values generic in the code. If the number of the attributes matter they are the last two of the block, Stampdesc is 38th and Stanmpdate is the 39th attribute.

     If there is a simple way to include two more attributes named STAMPDESC with a value of "Revision Comment" and STAMPDATE with a value of the current date I would very much appreciate it. Thanks for any help and if I find the solution I'll update the code from my original post.

 

 

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

 

Another option would be to add this code to the above but I haven't successfully got the current date to populate and I'm not sure how to include it in the above code. Either way thanks for any help!

(defun c:AttRenList ( / doc new tagLst)

  (setq tagLst ; All tags must be upper case.
    (list
      ;     OLD TAG       NEW TAG      PROMPT      VALUE
      (list "STAMPDESC" "STAMPDESC" "STAMPDESC" "ISSUED FOR CONSTRUCTION") ; \U+00A0 = Unicode non-breaking space.
      (list "STAMPDATE" "STAMPDATE" "STAMPDATE" "JUL XX, 2019")
    )
  )
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (vlax-for blk (vla-get-blocks doc)
    (if (= :vlax-false (vla-get-isxref blk))
      (vlax-for obj blk
        (cond
          ((= "AcDbBlockReference" (vla-get-objectname obj))
            (if (= :vlax-true (vla-get-hasattributes obj))
              (foreach att (vlax-invoke obj 'getattributes)
                (if (setq new (assoc (vla-get-tagstring att) tagLst))
                  (progn
                    (vla-put-tagstring att (cadr new))
                    (vla-put-textstring att (cadddr new))
                  )
                )
              )
            )

          )
          ((= "AcDbAttributeDefinition" (vla-get-objectname obj))
            (if (setq new (assoc (vla-get-tagstring obj) tagLst))
              (progn
                (vla-put-tagstring obj (cadr new))
                (vla-put-textstring obj (cadddr new))
                (vla-put-promptstring obj (caddr new))
              )
            )
          )
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

 

Edited July 11, 2019 by Billy Ray
Hoping for a response

[tombu]

For current date I'd use the field 

%<\AcVar Date \f "M/d/yyyy">%

For my drawings I generally use the Saved Date

%<\AcVar SaveDate \f "M/d/yyyy">%

which is basically when it was last saved.

[Billy Ray]

Thanks but i can't use field insertions as the date would change each time it is opened. The code above populates the currrent date as text and works great for what I need.

[BIGAL]

For the date (getvar 'cdate)

[Billy Ray]

That is already in the Lisp. My issue is adding two more attributes to it and reusing the cdate code for the stamp date. 

[tombu]

Old lisp by Bill Kramer that still works great below.  Couldn't find link with Google search so I've attached it.

After loading it 

(AstroCalendar (getvar "date"))

returns "7/12/2019".  Many other date functions as well.

Dates.lsp

[Billy Ray]

I appreciate the additional lisp. The lisp above already populates the date for one of the attributes. My issue is editing the lisp to include two more attributes "Stampdate" and "Stampdesc". I then would need the stampdate to match the value of the "ndate" atrribute and the stampdesc to match the value of the "ndesc" attribute. That is it. Sounds simple but I cannot edit the lisp correctly. I hope I've explained this well, thanks anyway.

[Roy_043]

Change:

(setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3"))

To:

(setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3" "STAMPDESC" "STAMPDATE"))

 

And change:

(list ndate nby ndes nchk napp)

To:

(list ndate nby ndes nchk napp ndes ndate)

 

Edited July 12, 2019 by Roy_043

[Billy Ray]

I have tried that. The edited code is below and stampdesc and stampdate do nothing but everything else updates as it should. So something is wrong. I put "xxx" for the date just to test it. Thank you for a relative answer though.

 

(defun c:ADDREV-IFC  (/ ttbn main-rev pral prul ndate nby ndes nchk napp stampdesc stampdate 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, stampdescription, stampdate
  (setq prul '("DATE" "IN1" "DESCRIPTION" "IN2" "IN3" "STAMPDESC" "STAMPDATE"))
  ; 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 "ISSUED FOR CONSTRUCTION" nchk "JP" napp "DEE" nstampdesc "ISSUED FOR CONSTRUCTION" nstampdate "XXX")
  (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 nstampdesc nstampdate))
      (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)
  )
)

 

[Roy_043]

Post the block.

[Billy Ray]

Attached

TITLE BLOCK.dwg

[Roy_043]

(defun c:ADDREV (/ ttbn main-rev pral prul date year month day ndate nby ndes nchk napp ttb old-rev revidx 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 : rev, date, by, description, checked, approved
  (setq prul '("REV" "DATE" "IN1" "DESCRIPTION" "IN2" "IN3")) ; Revidx will be appended to these tags.
  ; 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 (setq ttb (ssget "x" (list (cons 0 "INSERT") (cons 2 ttbn))))
    (progn
      (setq ttb (vlax-ename->vla-object (ssname ttb 0)))
      (setq old-rev (_saval ttb main-rev))
      (if (= old-rev "") (setq old-rev nil))
      (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)))
      )
      (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))))
        )
      )
      ; Process tags with appended revidx:
      (mapcar
        '(lambda (tag val) (_caval ttb (strcat tag revidx) val))
        prul
        (list new-rev ndate nby ndes nchk napp)
      )
      ; Process other tags:
      (mapcar
        '(lambda (tag val) (_caval ttb tag val))
        (list main-rev "STAMPDESC" "STAMPDATE")
        (list new-rev ndes ndate)
      )
    )
    (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)
  )
)

BTW:

Looking at the original code the revision numbering sequence is unclear because some of the code involved will never execute. In the revised code above the sequence is A, 0, 1, 2 etc. Strange IMO, but that seems to be what is intended.

Edited July 13, 2019 by Roy_043

[Billy Ray]

Thank you Roy, this is excellent. The only thing I forgot to mention was the date format is different for "stampdate". It is MMM DD, YYYY    ... my mistake. Thank you very much for the help!

[Billy Ray]

On 7/12/2019 at 3:05 PM, Roy_043 said:

BTW:

Looking at the original code the revision numbering sequence is unclear because some of the code involved will never execute. In the revised code above the sequence is A, 0, 1, 2 etc. Strange IMO, but that seems to be what is intended.

 

     I see that I can change "ndate" in the 17th line from the bottom, after list new-rev ndes, in the code and it will put that in the "stampdate" attribute, however I am not sure how to put the getvar cdate code in there instead to populate the current date in format MMM DD, YYYY .  I cut this out of the code and the first line has NDATE capitalized that I am referring to. Can I replace that with getvar cdate instead? I am not sure how to do so and have been trying. Thanks for any additional help.

 

 

(list new-rev ndes NDATE)
      )
    )
    (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)
  )
)

 

[Roy_043]

(defun c:ADDREV (/ ttbn main-rev pral nby ndes nchk napp ttb old-rev revidx new-rev)
  (setq
    ttbn "PLC_Anadarko_D_Bord_2017"                   ; ttbn = titbleblock name.
    main-rev "REV"                                    ; main-rev = tagname main revision attribute.
    pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5") ; project revision attribute list.
    nby "Drawn By Initials"
    ndes "Revision Comment"
    nchk "Check Initials"
    napp "Approve Initials"
  )
  (if (setq ttb (ssget "x" (list (cons 0 "INSERT") (cons 2 ttbn))))
    (progn
      (setq ttb (vlax-ename->vla-object (ssname ttb 0)))
      (setq old-rev (_saval ttb main-rev))
      (if (= old-rev "") (setq old-rev nil))
      (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)))
      )
      (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))))
        )
      )
      ; Process tags with appended revidx:
      (mapcar
        '(lambda (tag val) (_caval ttb (strcat tag revidx) val))
        '("REV" "DATE" "IN1" "DESCRIPTION" "IN2" "IN3")
        (list new-rev (menucmd "M=$(edtime,$(getvar,date),MO/DD/YY)") nby ndes nchk napp)
      )
      ; Process other tags:
      (mapcar
        '(lambda (tag val) (_caval ttb tag val))
        (list main-rev "STAMPDESC" "STAMPDATE")
        (list new-rev ndes (vl-string-subst "," ";" (menucmd "M=$(edtime,$(getvar,date),MON DD; YYYY)"))) ; MMM DD, YYYY
      )
    )
    (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 July 16, 2019 by Roy_043

[Billy Ray]

Amazing! I would have never got that. I just need the month (MMM) to be Capitalized. Currently it is "Jul" instead of "JUL" (Mmm), thanks again Roy!

[Roy_043]

(defun c:ADDREV (/ ttbn main-rev pral nby ndes nchk napp ttb old-rev revidx new-rev)
  (setq
    ttbn "PLC_Anadarko_D_Bord_2017"                   ; ttbn = titbleblock name.
    main-rev "REV"                                    ; main-rev = tagname main revision attribute.
    pral '("REV0" "REV1" "REV2" "REV3" "REV4" "REV5") ; project revision attribute list.
    nby "Drawn By Initials"
    ndes "Revision Comment"
    nchk "Check Initials"
    napp "Approve Initials"
  )
  (if (setq ttb (ssget "x" (list (cons 0 "INSERT") (cons 2 ttbn))))
    (progn
      (setq ttb (vlax-ename->vla-object (ssname ttb 0)))
      (setq old-rev (_saval ttb main-rev))
      (if (= old-rev "") (setq old-rev nil))
      (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)))
      )
      (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))))
        )
      )
      ; Process tags with appended revidx:
      (mapcar
        '(lambda (tag val) (_caval ttb (strcat tag revidx) val))
        '("REV" "DATE" "IN1" "DESCRIPTION" "IN2" "IN3")
        (list new-rev (menucmd "M=$(edtime,$(getvar,date),MO/DD/YY)") nby ndes nchk napp)
      )
      ; Process other tags:
      (mapcar
        '(lambda (tag val) (_caval ttb tag val))
        (list main-rev "STAMPDESC" "STAMPDATE")
        (list
          new-rev
          ndes
          (strcat
            (strcase (menucmd "M=$(edtime,$(getvar,date),MON)"))
            " "
            (menucmd "M=$(edtime,$(getvar,date),DD)")
            ", "
            (menucmd "M=$(edtime,$(getvar,date),YYYY)")
          )
        )
      )
    )
    (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)
  )
)

 

[Billy Ray]

Thnak you sir! I have much to learn. Every time I think I figure some of the simple lisp out .... it's not so simple. I appreciate it!

[Steven P]

Often I am asked to put on a date other than today, say to send a drawing out tomorrow (or one we should have sent out yesterday...) so I prefer to manually type it in. Lee Mac also has a function for entering a date.

 

Also if you have a few drawings to change Lee Macs MacAttEdit isn't a bad place to start - it remembers between drawings the last inputs and can work as a batch, you don't need to modify the LISP code to make changes.

 

I also have this as an alternative. Go into the LISP code, and change the revisionboxtext lists to suit your project, run the lisp and select according to the prompt each bit of text in the block to change. It takes a bit longer than yours however it is not relying on a specific named title block (for example we have title blocks A1, A2, A3 etc in one project - this will cover them all). it won't let you skip past an attribute so just have to fill in the next one a couple of times until is loops round to fill it in if you want to skip something

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:revbox(/ acount revisionboxtext listlength ent entlist) ;;adds revbox text


;;Make array of texts to change
;;- "prompt" "new text"-
;;add lines here to suit
  (setq revisionboxtext (list '"REV CODE" '"A"))
  (setq revisionboxtext (append revisionboxtext (list '"DATE" '"11/07/19")))
  (setq revisionboxtext (append revisionboxtext (list '"Rev Comment" '"ISSUE 1")))
  (setq revisionboxtext (append revisionboxtext (list '"Drawn" '"SP")))

;;Loop through array and change rev box details
  (setq acount 0)
  (setq listlength (length revisionboxtext))

  (while (< acount listlength)
    (princ "\n")
    (setq ent (car (nentsel (strcat "\nSelect " (nth acount revisionboxtext) " Text:"))))
    (setq entlst (entget ent))
    (setq entlst (subst (cons 1 (nth (+ 1 acount) revisionboxtext)) (assoc 1 entlst) entlst))
    (entmod entlst)
    (entupd ent)
    (setq acount (+ 2 acount))
  )

  (princ)
)

 

[Billy Ray]

Thanks Steven I'll check that out. I utilize Lee Macs MacAtt as well as Bfind. When the date does change it is unique to each DWG so we just Bfind it. I have been wanting to update this lisp to add all used Title Blocks or find an alternative. I will definitely try this one out. Sounds like Lee Macs UpdateTitleBlock routine but without the CSV which I would like. Thanks again!