Move Attribute Values In Block

We have a drawing border that uses four lines of attributes for tracking revisions. I'd like to write a routine to move the values in each line up one line, so the latest revision is always on the lowest line. I can extract the attribute tags and their values into an associated (dotted pair) list easily enough.

Since each line has attributes that are prefixed with a '1_', '2_', etc, I thought it would be easy to simply iterate through the list to change those numbers. It turns out that I was partially right. The list is easy to get, working with dotted pairs is not. My list looks like this: ("1_REV" . "1") ("1_DATE" . "04-11-13") ("1_DESCRIPTION" . "ADDED A BUTTERFLY VALVE TO THE BYPASS LOOP") ("1_BY" . "ABC"). I'd like to change all the instances of '1_' to '2_' in the list.

I might be making this too hard, I know I could simply store those values to variables and then just create a new list, then push the new values into the block attributes, but that seems somewhat inelegant.

Say you have the list as above:

_$ (setq data '(("1_REV" . "1") ("1_DATE" . "04-11-13") ("1_DESCRIPTION" . "ADDED A BUTTERFLY VALVE TO THE BYPASS LOOP") ("1_BY" . "ABC")))
(("1_REV" . "1") ("1_DATE" . "04-11-13") ("1_DESCRIPTION" . "ADDED A BUTTERFLY VALVE TO THE BYPASS LOOP") ("1_BY" . "ABC"))
_$ (mapcar '(lambda (pair)
          (if (wcmatch (car pair) "1_*")
            (cons (strcat "2_" (substr (car pair) 3)) (cdr pair))
            pair))
       data)
(("2_REV" . "1") ("2_DATE" . "04-11-13") ("2_DESCRIPTION" . "ADDED A BUTTERFLY VALVE TO THE BYPASS LOOP") ("2_BY" . "ABC"))

Another method is that because you have 4 lines you can actually read the attribute value by its creation order so its pretty easy to just move the values up 1 . It does though expect that you have created the lines one after another.

Pretty sure I had a better version than this it was done to move 1 only but can be changed to auto. You need to add a check first go to find blank entry so can work out how many up.

(vl-load-com)
(setq y 1)
(setq ss1 (car (entsel)))
(setq bname (vla-get-name(vlax-ename->vla-object SS1))) 

(setq x (getint "\nEnter line no to pick")) ; change this line in block
(SETQ newstrblank ".")
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
   (if (= y x)
   (progn
   (setq newstr (vla-get-textstring att ))
   (vla-put-textstring att newstrblank)
   )
   )
   (setq y (+ Y 1))
)
(setq y 1)
(setq x (getint "\nEnter line no to move to"))
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
   (if (= y x)
   (vla-put-textstring att newstr)
   )
   (setq y (+ Y 1))
)
(princ) 

....We have a drawing border that uses four lines of attributes for tracking revisions. I'd like to write a routine to move the values in each line up one line, so the latest revision is always on the lowest line.....

And this "latest" revision as new entry?

This would leave the values at "1_" level blank and "bump" everything else.

(defun c:bump ( / _relist attv ss)
;;;	pBe	15Apr2013	;;;
(defun _relist  (l n / x ln ls)
     (if (zerop (rem (length l) n))
           (repeat (/ (setq ln (length l)) n)
                 ((lambda (j)
                        (repeat j
                              (setq x (cons (nth (setq ln (1- ln))  l)
                                            x) )))
                       n)
                 (setq ls (cons x ls)
                       x  nil)
                 ))
     ls)  
 	(if (and
	(setq ss (ssget "_+.:S:E:L" '((0 . "INSERT") (66 . 1))))
	(setq Attv
	       (vl-remove-if-not
		 '(lambda (j)
		    (vl-some '(lambda (x)
				(if (wcmatch (vla-get-tagstring j) (strcat "#" x))
				  x
				)
			      )
			     '("_REV" "_DATE" "_DESCRIPTION" "_BY")
		    )
		  )
		 (vlax-invoke (vlax-ename->vla-object (ssname ss 0)) 'GetAttributes)
	       )
	)
	)
  (progn
    	(setq attv (reverse (_relist attv 4)))
    	(mapcar '(lambda (m n)
		   (mapcar '(lambda ( o p)
		   	(vla-put-textstring o (vla-get-textstring p) )) m n))
				attv (cdr attv))
    	(mapcar '(lambda (x) (vla-put-textstring x "")) (last attv))
    )
  )(princ)
   )

HTH

And this "latest" revision as new entry?

 

This would leave the values at "1_" level blank and "bump" everything else.

 

(defun c:bump ( / _relist attv ss)
;;;    pBe    15Apr2013    ;;;
(defun _relist  (l n / x ln ls)
     (if (zerop (rem (length l) n))
           (repeat (/ (setq ln (length l)) n)
                 ((lambda (j)
                        (repeat j
                              (setq x (cons (nth (setq ln (1- ln))  l)
                                            x) )))
                       n)
                 (setq ls (cons x ls)
                       x  nil)
                 ))
     ls)  
     (if (and
       (setq ss (ssget "_+.:S:E:L" '((0 . "INSERT") (66 . 1))))
       (setq Attv
              (vl-remove-if-not
            '(lambda (j)
               (vl-some '(lambda (x)
                   (if (wcmatch (vla-get-tagstring j) (strcat "#" x))
                     x
                   )
                     )
                    '("_REV" "_DATE" "_DESCRIPTION" "_BY")
               )
             )
            (vlax-invoke (vlax-ename->vla-object (ssname ss 0)) 'GetAttributes)
              )
       )
       )
     (progn
           (setq attv (reverse (_relist attv 4)))
           (mapcar '(lambda (m n)
              (mapcar '(lambda ( o p)
                  (vla-put-textstring o (vla-get-textstring p) )) m n))
                   attv (cdr attv))
           (mapcar '(lambda (x) (vla-put-textstring x "")) (last attv))
       )
     )(princ)
   )

 

HTH

Hey PBe could you help me getting this to work for my purposes?

I have a very similar situation requiring 5 tags to be moved up or down together, constituting a revision block. I'll attach images to explain concisely what i'm attempting.

not certain if you can see that, but there are 3 lines filled. two are in the correct positions and one has skipped a line, and thus needs to be moved to the line below. When I say "move" I actually mean that a prog needs to store the values of the tags that are out of place, then re-write those values to the correct corresponding tags within the same block, then delete out the old tags from their incorrect position. I hope this is easy enough to understand but I have not been able to find code that satisfies these conditions but would be incredibly grateful if someone would help in me obtaining that, it would be incredibly useful for us

Hey PBe could you help me getting this to work for my purposes?

I have a very similar situation requiring 5 tags to be moved up or down together, constituting a revision block. I'll attach images to explain concisely what i'm attempting...

I'll have a look-see tomorrow bhull1985, looks simple enough to code.

Yeah- should be but i'm lacking in attribute functions but figure i'll learn a lot more with this program, even if someone constructs it for me. there'd still be a lot to dissect and all, I sure would appreciate it.

thanks pBe, here's a link to my post in the autodesk forums that outline the objective a bit clearer:

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Copy-attribute-from-one-tag-to-another-tag-within-same-block/td-p/4550807

thanks!

Okay i read thru your post at the other forum. Correct me if i'm wrngo.. wonrg... wrong.

When you specify the integer "4"

Values at position 7 will disappear then values from 6 will got to 7, 5 to 6, 4 to 5 then leave 4 as blank?

What gets me is why do you need to bump when all the REV boxes are not yet filled up position 1? why start at a position already filled?

Or is this a "repair" job?

whichever revision tag is misplaced

Yes, basically.

All 5 attribute tags- REV#, R#DESC, R#BY, R#CHK, R#DATE will stay together.

But what happens is a situation similar to this:

(Hopefully you can see that, I'll attach it just in case it's too small)

But anyhow what happens is that when we run Lee Mac's global attribute editor on a set of 50-100 or more drawings, on occasion a few dwgs have their latest revision on a DIFFERENT line, and after the global attribute editor runs it leaves the title block looking like how it is in the jpg.

So, what I'd like to be able to do is tell it which line needs to be moved. Counting from the top of the rev block, but not the header line (which is at the very top of the block), the line that needs to be "bumped" down a few lines is #2.

So prog would ask (getint "What line to be moved?") and I would tell it "2". From there it should ask (getint "\nWhich line to move it to?"). If I want to "correct" this particular revision block, well then I'd need to tell it to move to line #5, because counting from the top, the 5th line is where the revision information needs to be moved to.

Hopefully that helps, and I must stress how important it is that the values be moved from the one tags to the new tags, not just a fancy grip edit of the attribute text. We need to be able to enter revisions in order, but Lee Mac's global attribute editor saves us hours each time we run it (cheers for that Lee), and if we can find a solution to this issue then we'd be made even more efficient.

I thank you for your time and for your attentions, and will owe you a big favor if you can write something capable of this. I will be attempting to do so but have little knowledge of attribute functions so it'll be a pickle. Learning though......

Here's another image of the revision block that would need the prog ran on it, with the background color changed. Hopefully this allows for a clearer understanding.

(naturally, all atts on the line to be moved get moved, not just the first attribute)

The tag names will remain constant and do so- Rev#, R#Desc, R#BY, R#CHK, R#Date.

So in the example Rev2, r2Desc, r2by, r2chk, r2date would need to be moved to rev5, r5desc, r5by, r5chk, r5date.

Thanks!

That means, the only time the program "bumps" the values if the target TAG# is already taken? or is it "Overwrite" the values at the target TAG#?

Or should the program detect the first target TAG# available? Which means the only time the program will do this if there are "vacant values" and this needs to be fix?

BTW: whats with the block name? "A$C3C6630F0"

Here's a draft

EDIT: Here's the modified code

(defun c:rvb (/ _AttFunc ss i e values vacant num)
;;;		pBe Oct262013		;;;
(defun _AttFunc  (en lst / vals v)
(mapcar (function (lambda (at)
(setq vals (list (vla-get-tagstring at)(vla-get-textstring at)))
         	(if (and lst (setq v (assoc (car vals) lst)))
                 	(vla-put-textstring at (cadr v))) vals))
                     (vlax-invoke (if (eq (type en) 'VLA-OBJECT)
                                 en (vlax-ename->vla-object en)) 'Getattributes)
 	)
 )
(defun #tonum (s1 s2 lst) (mapcar '(lambda (s)
			     (vl-string-translate s1 s2 s)
			   )
			  lst
		  ))  
(setq atlst '("REV#" "R#DESC" "R#BY" "R#CHK" "R#DATE"))  
 	(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (if	(setq values (vl-remove-if-not
		       '(lambda	(x)
			  (setq tgnm (car x)) (vl-some
			    '(lambda (y) (wcmatch tgnm y) ) atlst
			  ))(_AttFunc e nil)
		     )
	)
      (progn
	(setq vacant nil)
	(repeat	(setq num 7)
	  (if (vl-every '(lambda (p) (= (cadr (assoc p values)) "")) (#tonum "#" (itoa num) atlst))
		(setq vacant (cons num vacant))
	    	(if vacant
		  	(progn
		  	(_AttFunc e (mapcar '(lambda (t_ fr_)
				    (list t_ (cadr (assoc fr_ values))))
							    (#tonum "#" (itoa (last vacant)) atlst)
							    (#tonum "#" (itoa num) atlst)))
		 	(_AttFunc e  (mapcar '(lambda (y)(list y ""))
						      (#tonum "#" (itoa num)  atlst)))
			(setq vacant (cons num vacant) vacant (vl-remove (last vacant) vacant)))
		  )
		  )	  
	  	(setq num (1- num))
	  )
	)
      )
    )
  )(princ)
 )

EDIT: Here's the modified code

 

Or should the program detect the first target TAG# available? Which means the only time the program will do this if there are "vacant values" and this needs to be fix?

 

BTW: whats with the block name? "A$C3C6630F0"

Yes! Exactly. We need simply to move the values of the misplaced tags to the first vacant tags that are ontop of the previous revision. We would never need to "overwrite" our revision information programmatically, though I understand the confusion.

We just need to push revision info that was placed on the wrong line (via usage of lee mac's global attribute editor- that we can edit the rev info on one drawing and apply it to hundreds, thousands if required. The only catch is that sometimes it places the revisions like how they are in the images I posted, because not all drawings in an issue have the same amount of previous revisions. That leaves a few blank revision lines between the old revision and the one that we global attributed in, as per the images.

Hopefully that explains it even moreso, and thanks a ton for your time and routine.

I'm going to test it as soon as I finish with the client work just dumped onto my desk. They need the dates changed on a stamp and in the revision block, but no new lines of revision. Just time to fire up Lee Mac's global editor and knock this out, and then get to your code. Thanks so much, again!

Oh and as far as the block name - I couldn't tell you. The blocks are more aptly named in active drawings, I believe this one has the autocad designated name because I removed it from the project directory and copied onto my harddrive. Best guess as to why it got renamed.

btw impressive routine, looks complex. can't wait to delve in heh

Excellent!

This routine works great for my purposes and is speedy too with no alerting or unnecessary messages! Just bumps the misplaced line to the correct spot, great work pBe Thanks a ton!!!!

I owe ya for this'n

For it's deserving response please check this link :

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Copy-attribute-from-one-tag-to-another-tag-within-same-block/m-p/4557375#M316266

pBe, this is a totally non-important an only-to-be-done if you're completely bored and have a bit more time that you absolutely need something to do in because I really feel bad for asking for anything more after you've delivered in such a huge way.

....but I'm hoping you can comment out your code?

There are a lot of (lambda) functions that by definition are tough to know beforehand what they're doing.

Though, I request this only because I intend on learning something from this....well, learning *a lot* from this heh!

Weekends about to start so no rush, and if it doesn't get commented then I won't be complaining. Just really appreciate you tackling this one in the first place. Thx

Here is my attempt:

([color=BLUE]defun[/color] c:fixblk ( [color=BLUE]/[/color] a b i s x )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]mapcar[/color]
              '([color=BLUE]lambda[/color] ( a b )
                   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]vla-put-textstring[/color] ([color=BLUE]last[/color] a) ([color=BLUE]caddr[/color] b))) a b)
               )
               ([color=BLUE]setq[/color] a
                   ([color=BLUE]vl-sort[/color]
                       ([color=BLUE]mapcar[/color]
                          '([color=BLUE]lambda[/color] ( x )
                               ([color=BLUE]vl-remove[/color] [color=BLUE]nil[/color]
                                   ([color=BLUE]mapcar[/color]
                                      '([color=BLUE]lambda[/color] ( p )
                                           ([color=BLUE]vl-some[/color]
                                              '([color=BLUE]lambda[/color] ( a )
                                                   ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]cadr[/color] a) p) a)
                                               )
                                               x
                                           )
                                       )
                                      '([color=MAROON]"REV#"[/color] [color=MAROON]"R#DESC"[/color] [color=MAROON]"R#BY"[/color] [color=MAROON]"R#CHK"[/color] [color=MAROON]"R#DATE"[/color])
                                   )
                               )
                           )
                           (LM:groupbyfunction
                               ([color=BLUE]mapcar[/color]
                                  '([color=BLUE]lambda[/color] ( a )
                                       ([color=BLUE]list[/color]
                                           ([color=BLUE]vl-list->string[/color]
                                               ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]<[/color] 47 x 58))
                                                   ([color=BLUE]vl-string->list[/color] ([color=BLUE]vla-get-tagstring[/color] a))
                                               )
                                           )
                                           ([color=BLUE]strcase[/color] ([color=BLUE]vla-get-tagstring[/color] a))
                                           ([color=BLUE]vla-get-textstring[/color] a)
                                           ([color=BLUE]progn[/color] ([color=BLUE]vla-put-textstring[/color] a [color=MAROON]""[/color]) a)
                                       )
                                   )
                                   ([color=BLUE]vl-remove-if-not[/color]
                                      '([color=BLUE]lambda[/color] ( a )
                                           ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] ([color=BLUE]vla-get-tagstring[/color] a))
                                               [color=MAROON]"REV#,R#DESC,R#BY,R#CHK,R#DATE"[/color]
                                           )
                                       )
                                       ([color=BLUE]vlax-invoke[/color]
                                           ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                                           'getattributes
                                       )
                                   )
                               )
                               ([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]=[/color] ([color=BLUE]car[/color] a) ([color=BLUE]car[/color] b)))
                           )
                       )
                      '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]>[/color] ([color=BLUE]caar[/color] a) ([color=BLUE]caar[/color] b)))
                   )
               )
               ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]vl-every[/color] '([color=BLUE]lambda[/color] ( y ) ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]caddr[/color] y))) x)) a)
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Group By Function  -  Lee Mac[/color]
[color=GREEN];; Groups items considered equal by a given predicate function[/color]

([color=BLUE]defun[/color] LM:groupbyfunction ( lst fun [color=BLUE]/[/color] tmp1 tmp2 x1 )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] x1 ([color=BLUE]car[/color] lst))
       ([color=BLUE]progn[/color]
           ([color=BLUE]foreach[/color] x2 ([color=BLUE]cdr[/color] lst)
               ([color=BLUE]if[/color] (fun x1 x2)
                   ([color=BLUE]setq[/color] tmp1 ([color=BLUE]cons[/color] x2 tmp1))
                   ([color=BLUE]setq[/color] tmp2 ([color=BLUE]cons[/color] x2 tmp2))
               )
           )
           ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] x1 ([color=BLUE]reverse[/color] tmp1)) (LM:groupbyfunction ([color=BLUE]reverse[/color] tmp2) fun))
       )
   )
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Quick demo:

Excellent!

This routine works great for my purposes and is speedy too with no alerting or unnecessary messages! Just bumps the misplaced line to the correct spot, great work pBe Thanks a ton!!!!

I owe ya for this'n

You are welcome bhull1985, Glad i could help

pBe....but I'm hoping you can comment out your code?

I'll get to that later dude, I'll modify the code to match LMs post

Here is my attempt:..

Very nice LM.

Cheers Patrick!

I'll get to that later dude, I'll modify the code to match LMs post

Update Code at post # 11

Attached is the "commented" version of the code.

Have fun, Shout if you have any questions bhull1985

RemoveVacantBox.LSP