topic Re: LISP for filter and Change colors in Visual LISP, AutoLISP and General Customization Forum

LISP for filter and Change colors

khirunath — Sun, 06 Feb 2022 17:14:48 GMT

Hi,

I have this attached SWC code which I have got from the forum only. Which will select the all the objects within a selected closed polygon.

Im looking for an add-on to it. Below is my requirement.

After the SWC code, requested lisp is to filter out the below listed layers entities which contains polylines

D-200_875
D-200_750
D-400_500
D-400_625

then when all the entities from these layers selected I need to change the properties color by entering the A B C or D in the command bar. Below is the color defined for ABCD. Example if user type A in command bar means, it has to change the properties color to YELLOW(2)

A-CHANGE TO YELLOW(2)
B-CHANGE TO GREEN(3)
C-CHANGE TO ORANGE(242,103,34)
D-CHANGE TO MAGENTA(6)

Thanks in advance!

Re: LISP for filter and Change colors

john.uhden — Sun, 06 Feb 2022 19:36:12 GMT

I don't really understanding what you are doing. I am just a 2D civil kinda guy.

But I did try out your _pac function. I don't know if it makes any difference, but here are my observations and comments:

1. You are dividing the entire length of the polyline into an arbitrary 100 segments, as though that will improve accuracy.

2. In doing so, your derived points are cutting corners.

3. There is no need to add definition points along a straight segment. One point at each end will suffice.

Somewhere here, not too long ago, I posted code for getting a selection set within a polyline boundary. Similar to your _pac function, it adds points only along arced (bulged) segments, but includes each vertex as a point.

Oh, here it is (luckily I had copied it from my work computer onto my flash drive which I keep in my pocket)...

It requires a global called tightness which you might try in the range from 0.1 to 0.005, with the smaller being the tighter.

(defun @tighten (old / i bulge p1 p2 d1 d2 p d n new) ;; where old is LWpolyline data in the format... ;; '(e (b1 x1 y1)(b2 x2 y2) ... (bn xn yn)) (setq i 0 e (car old) old (cdr old)) (while (< i (1- (length old))) (setq p1 (nth i old) bulge (car p1) p1 (cdr p1) i (1+ i) p2 (cdr (nth i old)) new (cons p1 new) ) (if (/= bulge 0.0) (progn (setq d1 (vlax-curve-getdistatpoint e p1) d2 (vlax-curve-getdistatpoint e p2) d (- d2 d1) n (1+ (fix (/ d (abs (/ tightness bulge))))) ;; based on the theory that a smaller bulge needs fewer points dd (/ d n) d d1 add nil ) (repeat (1- n) (setq d (+ d dd) p (@2d (vlax-curve-getpointatdist e d)) new (cons p new) ) ) ) ) ) (reverse (cons p2 new)) ) ;; To get the polyline data in the "old" format (bulge x y), use... (defun (e / ent plist blist) (setq ent (entget e) plist (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 10)) ent)) blist (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 42)) ent)) ) (cons e (mapcar 'cons blist plist)) )

I am not sure about the balance of your project.

BTW, instead of

A-CHANGE TO YELLOW(2)
B-CHANGE TO GREEN(3)
C-CHANGE TO ORANGE(242,103,34)
D-CHANGE TO MAGENTA(6)

why not

Y-CHANGE TO YELLOW(2)
G-CHANGE TO GREEN(3)
O-CHANGE TO ORANGE(242,103,34)
M-CHANGE TO MAGENTA(6)

2-CHANGE TO YELLOW(2)
3-CHANGE TO GREEN(3)
30-CHANGE TO ORANGE(30)
6-CHANGE TO MAGENTA(6)

Re: LISP for filter and Change colors

khirunath — Mon, 07 Feb 2022 16:58:30 GMT

Hi John,

Sorry I could not able to understand your code that where I should use it. I'm still in learning stage in this VLISP programming.

_pac code will select all the entities within a closed polygon. After this, I have below list of layers that i want to filter from the selected objects. Just like using QSELECT command to filter the layers listed below. I used to do manually this for each 4 layers.

D-200_875
D-200_750
D-400_500
D-400_625

Coming to layer color

Y-CHANGE TO YELLOW(2)
G-CHANGE TO GREEN(3)
O-CHANGE TO ORANGE(242,103,34)
M-CHANGE TO MAGENTA(6)

this also fine to me.

Re: LISP for filter and Change colors

john.uhden — Mon, 07 Feb 2022 18:21:19 GMT

Let me get this straight.

You want to change to color of all polylines (only) on those 4 layers (only) found within the boundary of a selected polyline to either Yellow, Green, Orange, or Magenta, right?

When you say within do you mean "Window Polygon" or "Crossing Polygon?"

I presume you want to leave the boundary polyline out of the selection. It's probably on a different layer anyway, right?

Re: LISP for filter and Change colors

Kent1Cooper — Mon, 07 Feb 2022 18:39:06 GMT

After the other routine has established the 'add' variable selection set, this seems to turn all Polylines in it that are on those particular Layers to the color the User chooses for each Layer. Minimally tested.

(defun C:TEST () (setq collist '(("Yellow" 2) ("Green" 3) ("Orange" 30) ("Magenta" 6))) (foreach lay '("D-200_875" "D-200_750" "D-400_500" "D-400_625") (sssetfirst nil add) (if (setq PL-lay (ssget (list (cons 8 lay) '(0 . "LWPOLYLINE")))) (progn ; then (initget "Yellow Green Orange Magenta") (setq col (getkword (strcat "\nColor for Polylines on Layer " lay " [Yellow/Green/Orange/Magenta]: "))) (command "_.chprop" PL-lay "" "_color" (cadr (assoc col collist)) "") ); progn ); if ); foreach (princ) ); defun

Re: LISP for filter and Change colors

khirunath — Tue, 08 Feb 2022 09:39:25 GMT

Yes, I want to change to color of all polylines (only) on those 4 layers (only) found within the boundary of a selected polyline to either Yellow, Green, Orange, or Magenta.

When you say within do you mean "Window Polygon" or "Crossing Polygon?" - polygon(closed pline) which will be present in the drawing.

I presume you want to leave the boundary polyline out of the selection. It's probably on a different layer anyway, right? - Yes, its on a different layer.

Re: LISP for filter and Change colors

khirunath — Tue, 08 Feb 2022 09:44:26 GMT

Hello Kent,

I'm not able to run your code. How can I use it? Its just showing Select Objects: no further actions. Please help.

Re: LISP for filter and Change colors

Kent1Cooper — Tue, 08 Feb 2022 11:50:12 GMT

@khirunath wrote:

....

I'm not able to run your code. How can I use it? Its just showing Select Objects: no further actions. Please help.

Sorry -- mine is based on the assumption that the 'add' variable exists. [I made one for myself to test my code, rather than using yours.] Your SWC code has it as a localized variable, so it won't exist after that routine has finished. So for now, remove 'add' from the top line of your code, run it so that the 'add' selection set will exist, and then run mine. If it does what you want, mine can be folded in with yours, and the 'add' variable name put back into the localized variables list.

Re: LISP for filter and Change colors

CADaSchtroumpf — Tue, 08 Feb 2022 13:39:17 GMT

For try, if can be working for you. Command is "D-x2color"

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new) (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls))))) (while (cadr ls) (if (zerop (car lb)) (setq l_new (append l_new (list (car ls)))) (progn (setq rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0) a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb)))))) ) (if (< a 0.0) (setq a (- (* 2.0 pi) a))) (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0)) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) ) ) ) (setq ls (cdr ls) lb (cdr lb)) ) (append l_new (list (car ls))) ) (defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst) (setq inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin)) ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end))) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) ) (repeat nm (setq p1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) lst (append lst (list p1)) ) ) (setq p2 (polar pt_cen ang rad) lst (append lst (list p2)) ) (if (< sens 0.0) (reverse lst) lst) ) (defun c:D-x2color ( / ent dxf_ent typent closed lst l_bulg e_next key osmd opkb oapt vmin vmax minpt maxpt zt lst2 l_ent ss1 ss2 js_all tmp js n col) (while (null (setq ent (entsel "\nSelect entitie: ")))) (setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (cond ((eq typent "LWPOLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent)) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "POLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) e_next (entnext (car ent)) ) (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next))))) (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next)))) (setq lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst) l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg) ) ) (setq e_next (entnext e_next)) ) (setq lst (reverse lst) l_bulg (reverse l_bulg) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "LINE") (setq lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1)) closed 0 ) ) ((eq typent "CIRCLE") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) 0.0 (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) lst (append lst (list (car lst))) closed 1 ) ) ((eq typent "ARC") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) closed 0 ) ) (T (princ "\nIsn't Line, Arc, Circle or Polyline!")) ) (cond (lst (if (equal (last lst) (car lst)) (setq lst (cdr lst) closed 1)) (setq osmd (getvar "osmode") oapt (getvar "aperture") opkb (getvar "pickbox")) (setvar "osmode" 0) (setq vmin (mapcar '- (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0)) vmax (mapcar '+ (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0)) minpt (list (eval (cons min (mapcar 'car lst))) (eval (cons min (mapcar 'cadr lst)))) maxpt (list (eval (cons max (mapcar 'car lst))) (eval (cons max (mapcar 'cadr lst)))) ) (setq zt (or (< (car minpt) (car vmin)) (< (cadr minpt) (cadr vmin)) (> (car maxpt) (car vmax)) (> (cadr maxpt) (cadr vmax)))) (if zt (command "_.zoom" "_window" minpt maxpt)) (setvar "aperture" 1) (setvar "pickbox" 1) (if (zerop (getvar "pickfirst")) (setvar "pickfirst" 1)) (while (car lst) (setq lst2 (cons (car lst) lst2) lst (vl-remove (car lst) lst) ) ) (setq lst (reverse lst2)) (if (zerop closed) (setq ss1 (ssget "_F" lst '((8 . "D-200_875,D-200_750,D-400_500,D-400_625")))) (progn (initget "WPolygon CPolygon") (setq key (getkword "\nSelect by [WPolygon/CPolygon] <CP>: ")) (if (eq key "WPolygon") (setq ss1 (ssget "_WP" lst '((8 . "D-200_875,D-200_750,D-400_500,D-400_625")))) (setq ss1 (ssget "_CP" lst '((8 . "D-200_875,D-200_750,D-400_500,D-400_625")))) ) ) ) (setvar "pickbox" opkb) (setvar "aperture" oapt) (setq l_ent (if ss1 (ssnamex ss1)) js_all (ssget "_X" '((8 . "D-200_875,D-200_750,D-400_500,D-400_625"))) ) (foreach n l_ent (if (eq (type (cadr n)) 'ENAME) (setq ss2 (ssdel (cadr n) js_all)))) (if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) (progn (princ "\n<Click+left> to reverse the selection; <Enter>/[Space]/Click+rigth for finish!.") (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25)) (sssetfirst nil ss1) (cond ((eq (car key) 3) (setq tmp ss1 ss1 ss2 ss2 tmp) ) ) ) ) ) (if (setq js (ssget "_I")) (progn (initget 1 "Yellow Orange Green Magenta _2 30 3 6") (setq col (getkword "\nChange color to [Yellow/Orange/Green/Magenta]?: ")) (repeat (setq n (sslength js)) (setq dxf_ent (entget (ssname js (setq n (1- n))))) (if (assoc 62 dxf_ent) (entmod (subst (cons 62 (atoi col)) (assoc 62 dxf_ent) dxf_ent)) (entmod (append dxf_ent (list (cons 62 (atoi col))))) ) ) (sssetfirst nil nil) ) ) (setvar "osmode" osmd) ) ) (prin1) )

Re: LISP for filter and Change colors

john.uhden — Tue, 08 Feb 2022 14:05:50 GMT

@khirunath

You ought to know that there's a huge difference between Window and Crossing.

When you say "within" do you mean totally inside (window) or even just partially inside (crossing)?

Of course crossing includes everything totally inside as well.

Re: LISP for filter and Change colors

khirunath — Tue, 08 Feb 2022 15:00:40 GMT

Yes Its working after removing 'add' variable. But its asking 4 times to pick the color for each layer. All the 4 layers need to be changed to a single color.

Re: LISP for filter and Change colors

khirunath — Tue, 08 Feb 2022 15:03:05 GMT

Within means totally inside, no crossing over.

Yes crossing includes inside+crossing over.

Re: LISP for filter and Change colors

khirunath — Tue, 08 Feb 2022 15:30:51 GMT

This is working. Looks very big code. Not sure what is the initial coding, am not able to understand.

Re: LISP for filter and Change colors

Kent1Cooper — Tue, 08 Feb 2022 17:26:40 GMT

@khirunath wrote:

Yes Its working after removing 'add' variable. But its asking 4 times to pick the color for each layer. All the 4 layers need to be changed to a single color.

Something gave me the impression that you wanted to choose a separate color for those on each Layer. If not, this should do [untested this time]:

(defun C:TEST2 (/ collist col PL-lay) (setq collist '(("Yellow" 2) ("Green" 3) ("Orange" 30) ("Magenta" 6))) (initget "Yellow Green Orange Magenta") (setq col (getkword "\nColor for Polylines on those Layers [Yellow/Green/Orange/Magenta]: ")) (sssetfirst nil add); pre-select for the following to filter down: (if (setq PL-lay (ssget '((8 . "D-200_875,D-200_750,D-400_500,D-400_625") (0 . "LWPOLYLINE")))) (command "_.chprop" PL-lay "" "_color" (cadr (assoc col collist)) ""); then ); if (princ) ); defun

or using @CADaSchtroumpf 's more sophisticated use of what (initget) can do from Message 9:

(defun C:TEST2 (/ col PL-lay) (initget 1 "Yellow Orange Green Magenta _2 30 3 6") (setq col (getkword "\nColor for Polylines on those Layers [Yellow/Green/Orange/Magenta]: ")) (sssetfirst nil add); pre-select for the following to filter down: (if (setq PL-lay (ssget '((8 . "D-200_875,D-200_750,D-400_500,D-400_625") (0 . "LWPOLYLINE")))) (command "_.chprop" PL-lay "" "_color" col ""); then ); if (princ) ); defun

Re: LISP for filter and Change colors

CADaSchtroumpf — Tue, 08 Feb 2022 18:29:12 GMT

@khirunath a écrit :
This is working. Looks very big code. Not sure what is the initial coding, am not able to understand.

@khirunath

The code is imposing because I started from a generic code which is versatile.
I could reduce it enormously if your outline is just a polyline (no bulges)
Also remove the inversion from the selection.
If these conditions are met I can do it!

Re: LISP for filter and Change colors

khirunath — Sun, 30 Oct 2022 09:47:59 GMT

For the orange color in place of index color 30 I required True color 242,103,34 from RGB. What should I need to do so that this LISP can work? Please help