Run program on all selection set items

Run program on all selection set items

Anonymous
Not applicable
1,237 Views
5 Replies
Message 1 of 6

Run program on all selection set items

Anonymous
Not applicable

Im sure this has been covered ad infinitum but ive been hunting the forums and internet sources and cant get it to work.

 

Im converting a companies standard details to something resembling an actual standard. One of the issues is theres a mix of color by layer, by object and "just plop that on whatever layer has that color" throughout the master file.

The new standard detail... standard... is everything on a single detail layer with color set by entity. (this is done as these details will never change so a single layer to toggle on/off keeps things tidy elsewhere)

I wrote a working function that gets the layer color from an entity and appends it to the dxf description of that object. where ive run aground is finding a way to run that same function on each item in a selection set. Note, Im ok with lisp to a degree but never had to write something that processes like this so its a good learning opportunity.

 

Current Code:

(defun c:zza (/ obj curlay curlaycol )
	(setq obj (entget (car (entsel "\nSelect an object"))));set "obj" to the database definition of selected object
	(setq curlay (cdr (assoc 8 obj)));Get object layer name
	(setq curlaycol (cons 62 (cdr (assoc 62 (tblsearch "LAYER" curlay)))));get object layer color
	(setq obj (append obj (list curlaycol)));add color to object definition
	(setq obj (subst (cons 8 "DNL-DETAILS")(assoc 8 obj) obj));set object layer do "DNL-DETAILS"
	(entmod obj);Update object database definition
(princ))

 

I tried using a couple of the options from Lee Mac's tutorials, basically replacing "obj" entsel with "e" and replacing the the line "x (cdr (assoc 0 (entget currentent)))" with my program but i keep breaking the otherwise working sample code

(defun c:test1 ( / e i n s x )
    (if (setq s (ssget))
        (progn
            (setq i 0
                  n (sslength s)
            )
            (while (< i n)
                (setq e (ssname s i)
                      x (cdr (assoc 0 (entget e)))
                      i (1+ i)
                )
                (print x)
            )
        )
    )
    (princ)
)

 

TLDR: Im after pointers to convert my single object function to run on each entity in a selection set.

thanks in advance

0 Likes
Accepted solutions (1)
1,238 Views
5 Replies
Replies (5)
Message 2 of 6

doaiena
Collaborator
Collaborator
Accepted solution

Have in mind that "object" generally means VisualLisp object.

(car (entsel)) - returns an entity

 

A selection set is a bunch of entities. You need to iterate through the selection set and apply your functions to each entity within the selection set.

Your function will look like this if you would modify it to work with a selection set:

 

 

(defun c:zza (/ ss ctr obj curlay curlaycol )

(if (setq ss (ssget))
(progn

(setq ctr 0)
(repeat (sslength ss)

(setq obj (entget (ssname ss ctr)));set "obj" to the database definition of selected object
(setq curlay (cdr (assoc 8 obj)));Get object layer name
(setq curlaycol (cons 62 (cdr (assoc 62 (tblsearch "LAYER" curlay)))));get object layer color
(setq obj (append obj (list curlaycol)));add color to object definition
(setq obj (subst (cons 8 "DNL-DETAILS")(assoc 8 obj) obj));set object layer do "DNL-DETAILS"
(entmod obj);Update object database definition

(setq ctr (1+ ctr))
);repeat

));if ss

(princ)
);defun

 

 


If i had to write your function, i would write it like this:
I've heavily commented the code, to make it easier for you to follow.

 

 

(vl-load-com)
(defun c:zza ( / ss layers ctr obj )

;create a selection set
(if (setq ss (ssget))
(progn

;get all the layers in the drawing
(setq layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
;make sure "DNL-DETAILS" layer is present /create it if its not/
(vla-Add layers "DNL-DETAILS")

(setq ctr 0)
;iterate through the selection set
(repeat (sslength ss)
;convert the entity to a Vlisp object and assign in to 'obj'
(setq obj (vlax-ename->vla-object (ssname ss ctr)))
;change the object's color to that of its current layer
(vlax-put-property obj 'Color (vla-get-Color (vla-item layers (vlax-get-property obj 'Layer))))
;change the object's layer to "DNL-DETAILS"
(vla-put-Layer obj "DNL-DETAILS")
(setq ctr (1+ ctr))
);repeat

)); if ss

(princ)
);defun

 

 

 

0 Likes
Message 3 of 6

Anonymous
Not applicable

Awesome! thanks for breaking up the re-do of my example so I can see where the repition's happening clearly. and commenting the code.

Im making the shift from fairly basic lisp (i.e. (command "thing" "option" "") etc to autolisp so having actions commented really helps.

once Ive a handle on Autolisp it'll be on to visual lisp, baby steps though.

0 Likes
Message 4 of 6

Sea-Haven
Mentor
Mentor

Its ony a simple thing and lots code this way I just find it easier.

(repeat (setq x (sslength))
(setq e (ssname ss (setq x (- x 1))))
.............
.............
)

 

 

0 Likes
Message 5 of 6

Kent1Cooper
Consultant
Consultant

@Sea-Haven wrote:

....

(repeat (setq x (sslength))
(setq e (ssname ss (setq x (- x 1))))
.............
.............
)

[That should be  (repeat (setq x (sslength ss))  ]

 

That's the way I usually do it, too, as long as it doesn't matter in which order the things are processed [it starts at the end and works downward through the set, rather than from the beginning and working upward as those using (1+) functions do].  As if you need another option, this is an approach I sometimes used before settling down to the count-downward way:

(while (setq ent (ssname ss 0))
  ; first entity remaining in set, if any [nil when emptied]
  (... do whatever to 'ent' ...)
  (ssdel ent ss); remove that one from the set
); while

 It probably takes a little longer, though you'd never notice except with a pretty large selection set.

Kent Cooper, AIA
0 Likes
Message 6 of 6

Anonymous
Not applicable

Thanks all for your input. Ill definitly be referring back here for a couple other tools I have on the go!

0 Likes