Block attribute update routine

kameron1967 · ‎11-03-2011

I'm trying to find a routine that will look for ABC block and updates its NUM attributes depending on what's shown in the DESC attribute. There are about 5 of these ABC blocks in a drawing. Block ABC has 2 sets of attributes: DESC and NUM.

When run, it will look at the value of tag DESC, if it contains value XXX, then it will change the NUM value to 1111. And if DESC contains value YYY, then it will change the NUM value to 2222.

Hopefully this is clear. Thanks in advance.

pbejse · ‎11-03-2011

What if the value for DESC is something else other than "XXX" or"YYY"? will it be ignored?

pbejse · ‎11-03-2011

(defun c:NumIt (/ aDoc ss TagStr Tag Str Val)
  (vl-load-com)
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (ssget "_X" '((0 . "INSERT") (66 . 1)))
    (progn
      (vlax-for	itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	(if (and
	      (eq (vla-get-effectivename itm) "ABC")
	      (setq TagStr
		     (mapcar (function
			       (lambda (j)
				 (list (vla-get-tagstring j)
				       (vla-get-TextString j)
				       j
				 )
			       )
			     )
			     (vlax-invoke itm 'GetAttributes)
		     )
	      )
	      (setq Tag (assoc "DESC" TagStr))
	      (setq Str (assoc "NUM" TagStr))
	      (setq Val (member (strcase (cadr Tag)) '("XXX" "YYY")))
	    )
	  (vla-put-textstring
	    (last Str)
	    (if	(eq (strcase (car val)) "XXX")
	      "111"
	      "222"
	    )
	  )
	)
      )
      (vla-delete ss)
    )
  )
  (princ)
)

Anonymous · ‎11-03-2011

Awesome. To answer your question, yes - it will be ignored. Information for DESC is unique.

I will test it out tomorrow and will let you know, pbejse! You're too kind.

pbejse · ‎11-03-2011

@Anonymous wrote:
Awesome. To answer your question, yes - it will be ignored. Information for DESC is unique.

I will test it out tomorrow and will let you know, pbejse! You're too kind.

Ok, keep me posted kam1967

BTW you might want to change this line

(eq (vla-get-effectivename itm) "ABC")

to

(eq (strcase (vla-get-effectivename itm)) "ABC")

that would account for block name case sensitivity

HTH

pbejse · ‎11-03-2011

Kam1967,

As i was browsing thru the other threads, i noticed what you're looking for is entirely different from what i expected

If you're planning to use the above routine in a script or ODBX we may need to change how the routine looks for block/Tag names.

(defun numit (arg1 arg2...)

That way you can specify the block name for every drawing and not just limited to an specific name like "ABC" and tag names "DESC" and "NUM" or better yet, use a list as other contributors suggested.

(Numit "ABC" '"DESC" "NUM" '("XXX" "YYY"))

_.open "D:\my documents\sheet1.dwg" (Numit "ABC" '"DESC" "NUM" '("XXX" "YYY")) _.save _Y _.close

_.open "D:\my documents\sheet1.dwg" (Numit "OtherBlock" '"TAG1" "TAG2" '("L" "S")) _.save _Y _.close

......

Anyhooo. guess you can figure that out on your own kameron.

Anonymous · ‎11-03-2011

I appreciate the thought process though. I'll let you know tomorrow. Thanks again!

stevor · ‎11-04-2011

And while you make the more generic Subr to handle the other BLOCK and TAG names: the option for more than 2 tag names could be included, eg a "ZZZ" after the "YYY" etc.

S

kameron1967 · ‎11-04-2011

Pbejse,

I tested the routine. It worked for both the XXX and YYYs. I tried inserting another set of data ZZZ, but it does not seem to take. Can you see what I might've done wrong. Good job with the routine, by the way. It's really awesome.

Here is the routine. I switched some values to make it more understandable to everyone. So assume that XXX is really DESCVALUE1 and YYY is DESCVALUE2, the date associated to the XXX is then DESCDATE1 and YYY is DESCDATE2, the information I put in for DESCVALUE3 does not update DESCDATE3. Thanks again.

(defun c:NUMIT (/ aDoc ss TagStr Tag Str Val)
(vl-load-com)
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (ssget "_X" '((0 . "INSERT") (66 . 1)))
    (progn
      (vlax-for itm (setq ss (vla-get-ActiveSelectionSet aDoc))
(if (and
       (eq (vla-get-effectivename itm) "ABC")
       (setq TagStr
       (mapcar (function
          (lambda (j)
     (list (vla-get-tagstring j)
           (vla-get-TextString j)
           j
     )
          )
        )
        (vlax-invoke itm 'GetAttributes)
       )
       )
       (setq Tag (assoc "DESC" TagStr))
       (setq Str (assoc "DATE" TagStr))
       (setq Val (member (strcase (cadr Tag)) '("DESCVALUE1" "DESCVALUE2" "DESCVALUE3")))
     )
   (vla-put-textstring
     (last Str)
     (if (eq (strcase (car val)) "DESCVALUE1")
       "DESCDATE1"
       "DESCDATE2"

     "DESCDATE3"

     )
   )
)
      )
      (vla-delete ss)
    )
)
(princ)
)
(C:NUMIT)

pbejse · ‎11-04-2011

@kameron1967 wrote:
Pbejse,

     (if (eq (strcase (car val)) "DESCVALUE1")
       "DESCDATE1"
       "DESCDATE2"
     "DESCDATE3"

     )
   )
)

That line wont work at all. for "IF"
(eq (strcase (car val)) "DESCVALUE1")
       then do this
         otherwise do this)

you havent account for the rest of the values to test

for multiple test conditions use "COND"

(cond
   ((eq (strcase (car val)) "DESCVALUE1") "DESCDATE1")
   ((eq (strcase (car val)) "DESCVALUE2") "DESCDATE2")
   ((eq (strcase (car val)) "DESCVALUE3") "DESCDATE3")
)

But i wouldnt do that either, especially if number of values to test is unknown per drawing

So as per stevors' suggestion to use a generic sub-routine
(defun NumIt (blk tag1 tag2 lst1 lst2 / aDoc ss TagStr Tag Str Val)
  (vl-load-com)
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (ssget "_X" (list '(0 . "INSERT")
			'(66 . 1)(cons 2 (strcat blk ",`*U*"))))
    (progn
      (vlax-for	itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	(if (and
	      (eq (strcase (vla-get-effectivename itm))
		  (strcase blk))
	      (setq TagStr
		     (mapcar (function
			       (lambda (j)
				 (list (vla-get-tagstring j)
				       (vla-get-TextString j)
				       j
				 )
			       )
			     )
			     (vlax-invoke itm 'GetAttributes)
		     )
	      )
	      (setq Tag (assoc tag1 TagStr))
       	      (setq Str (assoc tag2 TagStr))
	      (setq Val (member (strcase (cadr Tag)) lst1))
	    )
	  (vla-put-textstring
	    (last Str)
	    (nth (vl-position (car val) lst1) lst2)
	  )
	)
      )
      (vla-delete ss)
    )
  )
  (princ)
)
(numinc blk tagname1 tagname2 lst1 lst2

1st arg -> Block nam,e "ABC"
2nd arg -> the first TAG name to check for Value
3rd arg - > the second TAG name to modify
4th arg - > a list of string value to check
5th arg - > a l;ist of string values to substitute

(numit "ABC" '("DESCVALUE1" "DESCVALUE2" "DESCVALUE3") '("DESCDATE1" "DESCDATE2" "DESCDATE3"))

Hope this helps

Anonymous · ‎11-05-2011

Yes, I believe this is exactly what I was looking to do. Thank you very much for all your help, pbejse. And thank you, stevor for that suggestion.

pbejse · ‎11-05-2011

@Anonymous wrote:
Yes, I believe this is exactly what I was looking to do. Thank you very much for all your help, pbejse. And thank you, stevor for that suggestion.

You are very welcome kameron, and hope you learn from it

Glad I could help.

Cheers

pbejse · ‎11-05-2011

(numit blk tag1 tag2 lst1 lst2)<--- correct syntax

my bad

for script

(setq blk "ABC" tag1 "DESC" tag2 "DATE"
lst1 '("DESCVALUE1" "DESCVALUE2" "DESCVALUE3")
   lst2 '("DESCDATE1" "DESCDATE2" "DESCDATE3"
  )
    )

(foreach itm (list 'blk 'tag1 'tag2 'lst1 'lst2)
(vl-propagate itm))

_.open "D:\my documents\sheet1.dwg" (numit blk tag1 tag2 lst1 lst2) _.save _Y _.close
_.open "D:\my documents\sheet2.dwg" (numit blk tag1 tag2 lst1 lst2) _.save _Y _.close

Anonymous · ‎11-05-2011

Thanks pbejse! I hadn't on using it as a script but since you put it so neatly, I might be tempted. I generally load a routine through lisp and run it through a program called proscript. Anyways, I appreciate all the thoughts you put in this. Thanks again! 🙂

Block attribute update routine

Block attribute update routine

Forums Links

Post to forums