More efficient LISP

Hello,

With much help from Jimmy D and Bob (ECCAD) recently, I have a LISP that creates a selection of a particular block and alters two vairables within it (adding leading zeros).

Basically, I have used the LISP Jimmy D has supplied me and repeated part of it. Is there a more efficient way of altering multiple attributes within a block?

Heres my lisp:
comments very much appreciated......

(defun c:test (/ blk att att1 str1 slen1)
(setq blk (ssget "x"(list (cons 0 "INSERT") (cons 2 "blockname"))))
(while (/= (sslength blk) 0)
(setq att (ssname blk 0))
(setq att1 (entget att))
(while (setq att1 (entnext (cdr (assoc -1 att1))))
(setq att1 (entget att1))
(if (= (cdr (assoc 2 att1)) "tagname1")
(progn
(setq str1 (cdr (assoc 1 att1))
slen1 (strlen str1)
); end setq
(if (= slen1 1)
(entmod (subst (cons 1 (strcat "0" str1)) (assoc 1 att1) att1))
);end if
); end progn
); end if
); end while
;;
;;
(setq att (ssname blk 0))
(setq att1 (entget att))
(while (setq att1 (entnext (cdr (assoc -1 att1))))
(setq att1 (entget att1))
(if (= (cdr (assoc 2 att1)) "tagname2")
(progn
(setq str1 (cdr (assoc 1 att1))
slen1 (strlen str1)
); end setq
(if (= slen1 1)
(entmod (subst (cons 1 (strcat "0" str1)) (assoc 1 att1) att1))
);end if
); end progn
); end if
); end while
;;
(ssdel att blk)
); end while
)

thanks,
dom

 

I'd try:


(and (setq ss (ssget "X" (list (cons 0 "INSERT")
(cons 2 "blockname")
(cons 66 1))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq en (entnext (ssname ss i)))
(while (/= "SEQEND" (cdr (assoc 0 (entget en))))
(setq ed (entget en))
(cond ((or (= (cdr (assoc 2 ed)) "tagname1")
(= (cdr (assoc 2 ed)) "tagname2"))
(and (setq str1 (cdr (assoc 1 ed)))
(= (strlen str1) 1)
(entmod (subst (cons 1 (strcat "0"
str1)) (assoc 1 ed) ed)))))
(setq en (entnext en)))))


Watchout for the word wrap. -David

 

Hi David,

thanks for the reply,

the code seems to work very well
when i get a mo' i'll have a closer look to see how it works.

would it be possible to add some comments to your code as it will help me no end?

Currently, the code puts a leading zero on the values held in the two tags, how would I go about having differing updated values? For example, one of the tag values needs two leading zeros and the other just one?

thanks very much

dom

 

In ActiveX (should be quickly):

(defun c:test (/ sel attval)
(vla-clear
(setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
)
(vla-select
sel
acselectionsetall
nil
nil
(vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 1)) '(0 2))
(vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 1)) '("INSERT" "blockname"))
)
(vlax-for ins sel
(if (= (vla-get-hasattributes ins) :vlax-true)
(foreach att (vlax-safearray->list (vlax-variant-value (vla-getattributes ins)))
(if (and (vl-position (strcase (vla-get-tagstring att)) '("TAGNAME1" "TAGNAME2"))
(= (strlen (setq attval (vla-get-textstring att))) 1)
)
(vla-put-textstring att (strcat "0" attval))
)
)
)
)
(princ)
)

 

(defun c:test2 (/ ss i an ad av tn)

(and (setq ss (ssget "X" (list (cons 0 "INSERT")
(cons 2 "blockname")
(cons 66 1))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq an (entnext (ssname ss i)))
(while (/= "SEQEND" (cdr (assoc 0 (entget an))))
(setq ad (entget an)
av (cdr (assoc 1 ad))
tn (cdr (assoc 2 ad)))
(cond ((= tn "tagname1")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "0"
av)) (assoc 1 ad) ad)))))
((= tn "tagname2")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "00"
av)) (assoc 1 ad) ad)))))
(setq an (entnext an)))))

(prin1))


;|

test2

use the overall (and) so that an empty selection set terminates
the program cleanly
- my preference over (if test (progn.... ))

filter INSERT type, black_name and SEQ 66 flag
- attributes can be removed from inserts

find the selection set length

step thru the selection set using a decremental counter
- terminate with a negative counter value

find the first ATTRIB ename

step thru the sequential entities
while not a SEQEND entity ( or test for ATTRIB type )
get the definition, attrib value & tagname
conditional testing to match tagname
test terminates upon first T statement
entmod the appropriate attribs with new string values


I try to be consistent with variable naming conventions:

ss - selection set
i - integer counter
en - entity name
ed - entity definition
an - ATTRIB ename
ad - ATTRIB definition
av - ATTRIB value
tn - tagname

If you get into a habit of being consistent, reading your own code
becomes a lot easier. I am also not a big fan of inline commenting
as I find more difficult to comprehend ( maybe bad eyesight on my end )

-David

|;

 

David,

thanks for your comments, i'll have a look at your code in detail as soon as I get a chance.

Thanks

dom

 

Alaspher,

Thanks for your reply.
I'm new to lisp even newer to ActiveX!
When I get time I will have a closer look at how it works.

Thanks for your help.

Dom

 

Hi David,

I've just tried your Lisp and i'm having trouble getting it to work...i'm getting the error: '; error: no function definition: nil'

I've run it thru the Vlisp editor and it gets to the line:
((= tn "tagname2")

any ideas??

thanks

dom

 

Try this:

(defun c:test3 (/ ss i an ad av tn)

(and (setq ss (ssget "X" (list (cons 0 "INSERT")
(cons 2 "blockname")
(cons 66 1))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq an (entnext (ssname ss i)))
(while (/= "SEQEND" (cdr (assoc 0 (entget an))))
(setq ad (entget an)
av (cdr (assoc 1 ad))
tn (cdr (assoc 2 ad)))
(cond ((= tn "tagname1")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "0"
av)) (assoc 1 ad) ad))))
((= tn "tagname2")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "00"
av)) (assoc 1 ad) ad)))))
(setq an (entnext an)))))

(prin1))

 

David,

Thanks for your swift reply. Your program works great!
I'm attempting to expand it a bit.......(see below)
What i'm wanting it to do is if the ROOMUSE tag has string length of 1 then add two leading zeros and if it has length of 2 add one leading zero. The program undertakes the first of the two changes but doesn't add the single leading zero to the tagvariable of length 2. Am I going about this in the correct manner,or by trying to analyse a particular tag more than once require something a bit more complicated?

Thanks
Dom

(defun c:test3 (/ ss i an ad av tn)
;
(and (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 "RoomData")(cons 66 1))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq an (entnext (ssname ss i)))
;
(while (/= "SEQEND" (cdr (assoc 0 (entget an))))
(setq ad (entget an)av (cdr (assoc 1 ad))tn (cdr (assoc 2 ad)))
;
(cond ((= tn "ROOMDFESCAT")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "0" av)) (assoc 1 ad) ad))))
;
((= tn "BLOCKNAME")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "0" av)) (assoc 1 ad) ad))))
;
((= tn "ROOMUSE")
(and (= (strlen av) 1)
(entmod (subst (cons 1 (strcat "00" av)) (assoc 1 ad) ad))))
;
((= tn "ROOMUSE")
(and (= (strlen av) 2)
(entmod (subst (cons 1 (strcat "0" av)) (assoc 1 ad) ad)))))
;
(setq an (entnext an)))))
;
(prin1))

 

You (and) testing is in the wrong place.

(cond ((and (= tn "ROOMDFESCAT")
(= (strlen av) 1))
(entmod (subst (cons 1 (strcat "0" av)) (assoc 1 ad) ad)))

(cond) termiates upon the first T test. -David

 

David,

If the and is in the wrong place how come your previous Lisp seemed to work?!
The corect syntax is as you've put '(cond((and', but if the condition arguement terminates upon the first non-nil, how do you get the program to evaluate every tag in succession regardless if prior arguements return a non-nil?

 

Because I only tested for the tag_name once. Your are testing for same
tag name multiple times. -David

 

I know I am!

So how do you test the same tag twice?

What is the correct syntax then if the code you posted on Nov4th.......

(cond ((= tn "tagname1")
(and (= (strlen av) 1)

and then.......

You (and) testing is in the wrong place.

(cond ((and (= tn "ROOMDFESCAT")
(= (strlen av) 1))
(entmod (subst (cons 1 (strcat "0" av)) (assoc 1 ad) ad)))

(cond) termiates upon the first T test. -David

I'm getting confused...

Thanks

Dom

 

There are a couple ways to do it:

(cond ((= tn "tagname1")
(and (= (strlen tn) 1)
(entmod ....))
(and (= (strlen tn) 2)
(entmod ....)))
((= tn "tagname2")
(and (= (strlen tn) 1)
(entmod ....))
(and (= (strlen tn) 2)
(entmod ....)))

);cond

or

(cond ((and (= tn "tagname1")
(= (strlen tn) 1))
(entmod ....))
((and (= tn "tagname1")
(= (strlen tn) 2))
(entmod ....))
((and (= tn "tagname2")
(= (strlen tn) 1))
(entmod ....))
((and (= tn "tagname2")
(= (strlen tn) 2))
(entmod ....))

);cond


-David

 

Thanks David,

I've sussed it out!

cheers

dom