Recursive Lisp that Rolls Attibutes Down a Revision List

[jn.compton]

Hi,

My organization has encountered a client that requires us to use their standard titleblocks.  The client requires us to fill in their revision attributes in reverse order starting with the top line. This means with every new revision we have to first copy each of the attributes down one revision line before we can add the new revision. With the size of drawing package and number of revisions we have, the amount of time required to add a single revision is getting out of hand.  The reason we are sticking with the attributes is our clients filing database software reads those attibutes into their filing system, so we can't mess with the titleblocks.

I myself tried to build a LISP routine using code from Lee Mac's website, and various posts and tutorials around the internet.  But I never ended up with something that works or that even begins to do what I want it to.

So in frustration, I am asking for help getting started on a new LISP.  If I have a drawing with only one tab that has a single titleblock that is always named "Client DWG Border", how do I recursively copy the contents of an attribute named "RevSlot4Number" into "RevSlot5Number", from slot 3 to slot 4, from slot 2 to slot 3 etc?

I had been trying to use (setq revSlotNoRead (strcat "RevSlot" (itoa lineNo) "Number")) to build a string in a loop (where lineNo started at 99 and decreased each time it looped) that would then be compared to the attributes in the titleblock and read the contents into a variable that would then be written into the next line.  But it never worked.

There are other attributes named "RevSlot1JobNumber", "RevSlot1Description", etc. but I'm sure once I can get one column automatically copying down one line, then I can just repeat the same code for the rest of the attributes.

Thanks,

j.com

[phanaem · Accepted solution]

Hi J

This is one way  to solve it:

(vl-load-com)

(defun C:TEST ( / *error* ss block old_att new_att)
  ;(setq *error* (err)) <---add your favourite error function
  (if
    (setq ss (ssget ":E:S:L" '((0 . "INSERT") (2 . "Client DWG Border"))))
    (progn
      (setq block (vlax-ename->vla-object (ssname ss 0)))
      (setq old_att (get_rev_data block))
      
      (setq new_rev (getstring "\nRev number: "))
      (setq new_job (getstring "\nJob number: "))
      (setq new_des (getstring "\nDescription: " T))
      ;(setq new_val <----- add more att values

      
      (setq new_att
        (add_rev_data
          old_att
          (list
            new_rev
            new_job
            new_des
            ;new_val <----- add more att values
          )
        )
      )
      (update_att block new_att)
      )
    )
  ;(*error* nil)
  (princ)
  )

(defun get_rev_data (block / att_list att_tag rev_no rev_jb rev_ds)
  (foreach att (vlax-invoke block 'getattributes)
    (setq att_tag (strcase (vla-get-tagstring att)))
    (cond
      ((wcmatch att_tag "REVSLOT*JOBNUMBER")
       (setq rev_jb (cons (list att_tag (vla-get-textstring att)) rev_jb))
       )
      ((wcmatch att_tag "REVSLOT*NUMBER")
       (setq rev_no (cons (list att_tag (vla-get-textstring att)) rev_no))
       )
      ((wcmatch att_tag "REVSLOT*DESCRIPTION")
       (setq rev_ds (cons (list att_tag (vla-get-textstring att)) rev_ds))
       )
;;;      ((wcmatch att_tag "REVSLOT*NAME")    <-- add more attributes if required
;;;       (setq rev_att4 (cons (list att_tag (vla-get-textstring att)) rev_ds))
;;;       )
      )
    )
  (mapcar
    '(lambda (l)
       (vl-sort l '(lambda (a b) (< (car a) (car b))))
       )
    (list rev_no rev_jb rev_ds)
    )
  )


(defun add_rev_data (old_att new / )
  (mapcar
    '(lambda (l n)
       (mapcar
         '(lambda (a b)
            (list (car a) (cadr b))
            )
         l
         (cons (list "" n) l)
         )
       )
    old_att
    new  
  )
)

(defun update_att (block new_att / a)
  (setq new_att (apply 'append new_att))
  (foreach att (vlax-invoke block 'getattributes)
    (if
      (setq a (assoc (strcase (vla-get-tagstring att)) new_att))
      (vla-put-textstring att (cadr a))
      )
    )
  )

For more attributes see the comments in the code.

I did some tests following your description, but there are a few things I want to mention:

- I used string sorting for each RevSlot and you might get into trouble if there are more than 10 revision lines and the numbering attributes are like "Revslot1" "Revslot2" ... "Revslot10" ... In this case you need a better sorting algorithm, or change the attribute tagstring from Revslot1 to Revslor01 etc. Not sure if your client agree. OR, you can sort attribute by possition.

- The lisp is working even if you don't enter any text when it prompts for new values and you might end up having a empty revision line. You can avoid this with a loop in (getstring...  lines, or some other methods if you prefer. Just notice it can happen.

- if you have more revisions than revision attributes, when you enter a new revision the oldest one is discharged. So, if you have only 5 revision lines and you have to add the 6-th revision, it only show revisions 2 to 6.

[jn.compton]

Wow, thanks.  I didn't expect to have my work done for me.  This is really great.  It's people like you who make this a supportive community.

I have taken your code and added the remaining revision attributes.  It now moves all of the revision lines down one.  It successfully does what I want it to do.

There will be more than 10 revisions unfortunately and I can't change the attribute tag name because the client uses the tag names in their filing database.  To solve the sorting issue, I'm thinking I might get it to work by breaking the revisions into lists of 10.  Say I do revision lines 19 to 10 first, then repeat the process for 9 to 1.  This would avoid creating a list that goes 1, 10 11...2, 3, 4.

[dbroad]

Even though your problem is solved, you may want to rethink the way you annotate revisions.  Unless I've misunderstood your needs, use a table for revisions.  Insert a new row above the current row and just enter the revision.  Skip the copying.

[Anonymous]

Here something that could help you.

I use a few support functions

PutAttrVal

GetAttrVal

FindDigits

Attached is tmp.ipn file, rename it to tmp.fas and load it. It contains above functions.

(defun C:ElevateAttribute ( / bl attr)
  (setq bl (car(entsel)))
  (setq attr(cdr(assoc 2(entget (car(nentsel ))))))
  (moveAttr attr bl )
)
	
(defun moveAttr (name bl / number val nameNext)
  (setq val (getattrval bl name))
  (if (/= val "")
    (progn
      (setq number(itoa (1+(atoi(nth 1(setq name(FindDigits  name)))))))
      (setq name (strcat (nth 0 name)number(nth 2 name)))
      (moveAttr name bl)
    )
  )
  (setq number(itoa (1-(atoi(nth 1(setq nameNext(FindDigits  name)))))))
  (setq nameNext (strcat (nth 0 nameNext)number(nth 2 nameNext)))
  (setq val (getattrval bl nameNext))
  (putattrval bl name val)
)

Call ElevateAttribute from autocad.

Select Block

Select top attribute

If you know names of all attributes I would recommend update the code. Instead of selecting attribute

Use something like this

(moveAttr "RevSlot1JobNumber" bl)

(moveAttr "RevSlot1Description" bl)