Stepping through block attributes

Hello,

I'm getting in a pickle!

I am having trouble in understanding how to step through block attributes until a particular tag is found.

I have a number of blocks named "REVISION", and then I need to replace the value in the "CHECKED" tag with a user defined one.

my poor crack at writing some lisp..........

(defun c:revup ()
(setq rev (ssget))
(setq ele (ssname rev 0))
(setq ents (entget ele))
(while (setq ents (entnext (cdr (assoc -1 ents))))
(setq ents1 (entget ents1))
(if (= (cdr (assoc 2 ents1)) "CHECKED")
(progn
(setq val (cdr (assoc 1 ents1)))
(entmod.............

Creating the selection set is the easy part......is this the correct method for stepping through the block until "SEQEND" is met? is there a better method?

Once I understand how to step through a block until a certain tag is met, Iwould like to place further conditions in the program. For example, I have a "DATE" tag, and would wish to only alter the "CHECKED" tag if the "DATE" tag was a particular value.........

I greatly appreciate your help.....I'm struggling to learn LISP what with other work commitments...so any pointers to get me started and understand some of the basic protocols would be great.

Thanks
Dom

 

Hi Dom,

First of all, your lisp debut isn't a poor crack. We all need to learn.
I revised your routine and I hope you can see how it works.
The program goes thru the selected block untill it finds the right tag-name, then the tag-value is changed into the word "VALUE"

(defun c:revup ()
(setq rev (ssget))
(setq ele (ssname rev 0))
(setq ents (entget ele))
(setq SORT nil)
(while (/= SORT "SEQEND") ;<-- doe untill SEQEND is found
(progn
(setq ents1 (entnext (cdr (assoc -1 ents))))
(setq ents (entget ents1))
(setq SORT (cdr (assoc 0 ents)))
(if (= (cdr (assoc 2 ents)) "CHECKED") ;<--tag = CHECKED?
(progn ;<--tag = CHECKED = true : doe things
(setq ents (subst (cons 1 "VALUE") (assoc 1 ents) ents ))
(entmod ents)
(princ ents)
);end progn
);end if
);end progn ;<-- search for following tag
);end while
);end defun

I hope this is of any help.

Jimmy

 

Hi Jimmy,

Thanks for the reply, your code works great.

If I were to expand the program to only change values when another tag is of a certain value, how would I go about it?

Following on from the line:

(while (/= SORT "SEQEND")
(progn
find tag "DATE" if it equals certain value then
find tag "CHECKED" and entmod......
);end progn

would this be the correct way to go about it?

Thanks
Dom

 

Hi Dom,

Sorry for the late reply but I had some days off.

I don't think what you propose will work because if you step thru the block and FIRST you find the DATE tag and then you find the CHECKED tag, you will not come by the DATE tag again to change it, so this means that you will have to go thru the block again a second time to find the DATE tag and change it.

If you want some more help on this, please do let me know!

Jimmy

 

Try this one:

(defun c:revup ()
(setq rev (ssget))
(setq ele (ssname rev 0))
(setq ents (entget ele))
(setq SORT nil date "" checked "")
(setq date_wanted (getstring 1 "\nLook for Date :"))
(while (/= SORT "SEQEND") ;<-- doe untill SEQEND is found
(progn
(setq ents1 (entnext (cdr (assoc -1 ents))))
(setq ents (entget ents1))
(setq SORT (cdr (assoc 0 ents)))
(if (= (cdr (assoc 2 ents)) "CHECKED")
(setq checked (cdr (assoc 1 ents))); get checked value
); if
(if (= (cdr (assoc 2 ents)) "DATE")
(setq date (cdr (assoc 1 ents))); get checked value
); if

(if (= date date_wanted)
(progn
(setq ents (subst (cons 1 "VALUE") (assoc 1 ents) ents ))
(entmod ents)
(princ ents)
);end progn
);end if
);end progn ;<-- search for following tag
);end while
);end defun

Bob

 

Thanks Jimmy and Bob for your replies.

I've just had a look at Bob's code, but am I right to believe this will not work for more than 1 'revision' insertion, because in effect you have to select a particular 'revision' block. What I am trying to get at is to create a selection set of all 'revision' blocks, over a number of layouts, find ones that have a 'date' value of x, and then entmod the 'checked' tag with y.

Firstly, I create my selction set.
Do I then have to find the 'date' tag of value x using while and if?
Then do a while and if to find the 'checked' tag and entmod with value y?
Or, do I create a selection set of 'revision' blocks having 'date' tag value of x, and then undergo a while and if to change the 'checked' values of this new selection set?

Hope this is clear!, and I very much appreciate your input

Thanks,

dom

 

Any ideas anyone??

 

Hi dhorton

- Are the 'date' and 'checked' tag in the same block, or in different inserts?
- Is it necessary to proceed *all* blocks with the name 'revision', or do you
want an user interaction to select the block(s)?

Cheers

 

This should do it.
(defun c:revup ()
(setq rev (ssget "X" '((2 . "revision")))); select all revision blocks
;;(setq rev (ssget))
(if (/= rev nil)
(progn
(setq C 0); counter
(repeat (sslength rev); do all
(setq ele (ssname rev C))
(setq ents (entget ele))
(setq SORT nil date "" checked "")
(setq date_wanted (getstring 1 "\nLook for Date :"))
(while (/= SORT "SEQEND") ;<-- doe untill SEQEND is found
(progn
(setq ents1 (entnext (cdr (assoc -1 ents))))
(setq ents (entget ents1))
(setq SORT (cdr (assoc 0 ents)))
(if (= (cdr (assoc 2 ents)) "CHECKED")
(setq checked (cdr (assoc 1 ents))); get checked value
); if
(if (= (cdr (assoc 2 ents)) "DATE")
(setq date (cdr (assoc 1 ents))); get checked value
); if

(if (= date date_wanted)
(progn
(setq ents (subst (cons 1 "VALUE") (assoc 1 ents) ents ))
(entmod ents)
(princ ents)
);end progn
);end if
);end progn ;<-- search for following tag
);end while
); repeat
));; progn,if
);end defun

Bob

 

Hi Juerg,

The block 'Revision' contains tags 'Date' and 'Checked' among others. A duplicate 'Revision' block will appear on a number of layouts. With the user specifying a particular date corresponding with that given in the 'Date' tag of the 'Revision' block and then specifiying details to go into the 'Checked' tag. I would like the program to find every instance of 'Revision' with said date and update the 'Checked' tag with details from the user.

Hope that is clear!

Thanks

Dom

 

try this one

(defun C:try (/ blks len i blist indate ndata bl atts tags i1)
(vl-load-com)
(setq indate (getstring "Enter date of Block to change: "))
(setq ndata (getstring T "\nEnter New Data for Checked Tag: "))
(setq blks (ssget "_X" '((0 . "Insert") (2 . "Revision"))))
(setq len (sslength blks))
(setq i 0)
(repeat len
(setq bl (vlax-ename->vla-object (ssname blks i)))
(setq atts (vlax-safearray->list
(vlax-variant-value (vla-getattributes bl))
)
)
(setq tags nil)
(foreach n atts
(setq tags (cons (vla-get-Textstring n) tags))
)
(setq i1 0)
(if (member indate tags)
(progn
(repeat (length atts)
(if (= (vla-get-TagString (nth i1 atts)) "CHECKED")
(vla-put-textstring (nth i1 atts) ndata)
)
(setq i1 (+ 1 i1))
(vla-update bl)
)
)
)
(setq i (+ 1 i))
)
)

 

Hi Dom

It's not tested, but could work:

Code:

(defun C:WatchRevision ( / AcaDoc AttLst ChkFlg Curent CurObj FltLst)
(vl-load-com)
(setq FltLst '((0 . "INSERT") (2 . "revision") (66 . 1)))
(if (setq CurSet (ssget "X" FltLst))
(progn
(setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcaDoc)
(while (setq Curent (ssname CurSet 0))
(setq CurObj (vlax-ename->vla-object Curent)
AttLst (MeGetAtts CurObj)
ChkFlg (eq (cdr (assoc "DATE" AttLst)) "DateValue")
)
(if ChkFlg
(progn
(setq AttLst (subst
(cons "CHECKED" "CheckedValue")
(assoc "CHECKED" AttLst)
AttLst
)
)
(MeSetAtts CurObj AttLst)
)
)
(ssdel CurEnt CurSet)
)
(vla-EndUndoMark AcaDoc)
)
)
(princ)
)
;
; == Function MeGetAtts
; Reads all attribute values from a block
; Arguments [Typ]:
;   Obj = Object [VLA-OBJECT]
; Return [Typ]:
;   > Dotted pair list '(("Tag1" . "Val1")...) [LIST]
; Notes:
;   None
;
(defun MeGetAtts (Obj)
(mapcar
'(lambda (Att)
(cons
(vla-get-TagString Att)
(vla-get-TextString Att)
)
)
(vlax-invoke Obj 'GetAttributes)
)
)
;
; == Function MeSetAtts
; Modifies attribute values in a block.
; Argumente [Type]:
;   Obj = Block object [VLA-OBJECT]
;   Lst = Attribute list '((Tag1 . Val1)...) [LIST]
; Return [Type]:
;   > Null
; Notes:
;   None
;
(defun MeSetAtts (Obj Lst / AttVal)
(mapcar
'(lambda (l)
(if (setq AttVal (cdr (assoc (vla-get-tagstring l) Lst)))
(vla-put-textstring l AttVal)
)
)
(vlax-invoke Obj 'GetAttributes)
)
(vla-update Obj)
(princ)
)

Cheers

 

Hi Juerg,

Thanks for the code, i've just tried it and it seems to work very well.
I'll have to have a closer look at it when I get chance.

Thanks anyway for your help

dom

 

Hi Dann,

Just tried your code and that also seems to work very well.
When I get a mo' i'll ahve to have a closer look at it to see how it works.
Thanks for your help.

Cheers

Dom