topic Re: Color 3DFace entities according to their Z-value. (modify existing lisp code) in Visual LISP, AutoLISP and General Customization Forum

Color 3DFace (and Polyline, Text, or Point) entities according to their Z-value. (Modify existing lisp code)

Yasir.Aman — Tue, 21 Mar 2023 08:05:20 GMT

Hi,

Here is a fabulous Code I found somewhere which is by LeeMac probably. This code applies color to 3DFace entities according to their Z-value.

(defun c:zmap ( / cma cmi del elv enx idx lst pct rng sel zmn zmx ) (setq cmi '(0 0 255) ;; Minimum colour cma '(255 0 0) ;; Maximum colour zmx -2.0 zmn -14.0 ) (if (setq sel (ssget "_:L" '((0 . "3DFACE")))) (progn (repeat (setq idx (sslength sel)) (setq enx (entget (ssname sel (setq idx (1- idx)))) elv (if (= "3DFACE" (cdr (assoc 0 enx))) (max (cadddr (assoc 10 enx)) (cadddr (assoc 11 enx))) (cdr (assoc 38 enx)) ) lst (cons (list enx elv) lst) zmx (max zmx elv) zmn (min zmn elv) ) ) (setq rng (mapcar '- cma cmi) del (- zmx zmn) ) (if (equal 0.0 del 1e-8) (princ "\nNo change in elevation.") (foreach itm lst (setq pct (/ (- (cadr itm) zmn) del)) (entmod (append (car itm) (list (cons 420 (apply 'LM:rgb->true (mapcar '(lambda ( a b ) (+ a (* b pct))) cmi rng) ) ) ) ) ) ) ) ) ) (princ) ) ;; RGB -> True - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->True ( r g b ) (logior (lsh (fix r) 16) (lsh (fix g) (fix b)) ) (princ)

The only problem with this code is that I can only select two colors and it will create a gradient based on them. Instead, I need to be able to select more than two colors, such that the gradient starts from the first (minimum) color and proceeds to next colors, and finally ending on the last (maximum) color.

For starters, you can try to include (some or all of) the following colors.

(setq cmi '(0 0 255) ;; Minimum colour col_2 '(0 95 255) col_3 '(0 205 255) col_4 '(0 255 160) col_5 '(30 255 0) col_6 '(215 255 0) col_7 '(255 225 0) col_8 '(255 185 0) col_9 '(255 100 0) cma '(255 0 0) ;; Maximum colour )

Any help?

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 08:24:20 GMT

hey, not a modification, but paints with what you want

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Thu, 16 Mar 2023 11:58:49 GMT

@komondormrex Thank you so much for your effort. This works great, but I still have two questions.

What if I need to increase or decrease the number of colors? Can I just add or remove RGB codes from the list?
What if I need to limit the colors inside certain elevation range? For example, (using the cad file I provided) what if I say apply the "minimum" color to all the entities with Z-value less than -10m and apply the "maximum" color to all the entities with Z-value greater than -4m. (Screenshot Attached).

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Thu, 16 Mar 2023 13:16:13 GMT

What if I need to increase or decrease the number of colors? Can I just add or remove RGB codes from the list?

yes, you can do this

What if I need to limit the colors inside certain elevation range? For example, (using the cad file I provided) what if I say apply the "minimum" color to all the entities with Z-value less than -10m and apply the "maximum" color to all the entities with Z-value greater than -4m. (Screenshot Attached).

that might be think over

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Thu, 16 Mar 2023 13:27:42 GMT

@komondormrex Ok I figured out the answer to my first question. Using the following line I can control the number of colors.

(setq tenth_z_scale (/ z_scale 9.0)

Now I have to figure out a way to automatically count the number of colors in the list and then update this line accordingly.

Anyway, that leaves only question No. 2 for you. 😊

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Thu, 16 Mar 2023 13:40:37 GMT

better be done with length function. see updated code above.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Thu, 16 Mar 2023 13:55:50 GMT

Yes. I figured it out but my method is lengthy. I did this;

num_colors (length color_gradation_list) ... (setq tenth_z_scale (/ z_scale (- num_colors 1))

I am quiet new to this world. Your code is graceful.

Anyhow, please help me with the 2nd question if possible.

Thanks a lot.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Thu, 16 Mar 2023 14:47:05 GMT

well, i have updated the code to comply with point 2. pay attention to lines

min_max_height_list '(-10 -4) - sets min and max heights to color

; min_max_height_list nil - unsets min and max heights to color

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Fri, 17 Mar 2023 19:08:22 GMT

@komondormrex Thank you very much for your great amount of thought and effort. I do appreciate every single moment of your time that you spent on this.

This final update *almost* complies with point 2, as it colors the entities falling within the predefined elevation range as white (255,255,255), instead of the colors defined in the color-gradation-list.

However, as per my working requirements, the final update almost solves my problem. Therefore, I am happily marking this update as the SOLUTION.

I feel like I cannot thank you enough.

Stay blessed and live long.

~Yasir

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 08:06:07 GMT

i have mistaken with min max range( but i have updated the code and corrected that issue, also i have updated the way gradation looks. it is way smoother now)

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Mon, 20 Mar 2023 11:48:18 GMT

Thanks @komondormrex for taking a good working solution to the next level and making it almost perfect.

However, the slight imperfection (color gradient not being smooth) is actually quite useful technically. For instance, if one has to visually inspect or modify entities falling under a certain elevation range, the non-smooth pre-defined colors makes it really easy to select such entities.

Therefore, please post the previous version of your code also. I want to accept it as a second solution too.

Finally, I don't want to sound too demanding, but I have another question. What if I want to apply the same color grading to entities other than 3DFaces? (e.g. Polylines, Points, or Text objects). Is it better to modify this code you already provided or should I try to rewrite separate code for every type of entity? Which option can prove more efficient?

P.S. The Text objects I mention will be actually placed on the Z-elevation in drawing, regardless of the contents of the text object. It means I don't need to analyze the actual content of the text objects to classify them for various levels.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 13:07:58 GMT

hello again!

as per previous version i can't post it, cause there is no more of it. but i have changed the code so you can select either to smooth or not coloring of the objects. see it right below. there is commented out smooth_gradation variable set to true. if you uncomment it, gradation will be smooth.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 13:11:42 GMT

as per different entities which you want to color due to theirs z value, there is no need to rewrite code for each of them. it is better be to change the code to gather z values for each different entity in different way.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Mon, 20 Mar 2023 13:21:33 GMT

Thank you for your quick response. Highly appreciated.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 13:22:40 GMT

your welcome)

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Mon, 20 Mar 2023 14:18:48 GMT

code for different enames should go like this. no matter how do you select them, each z coordinate for each ename will be treated independently for the whole selection set.

;***************************************************************************************************************************************************************** ; komondormrex, mar 2023 ;***************************************************************************************************************************************************************** (defun get_mid_color (color_value color_gradation_list / color_number) (setq color_number (atoi (rtos color_value))) (if (< color_number (1- (length color_gradation_list))) (mapcar '(lambda (color_1 color_2) (- color_1 (atoi (rtos (* (- color_value (fix color_value)) (- color_1 color_2)) 2 0)))) (nth color_number color_gradation_list) (nth (1+ color_number) color_gradation_list) ) (nth color_number color_gradation_list) ) ) ;***************************************************************************************************************************************************************** (defun c:a-la_z_gradient (/ color_gradation_list ename_list min_z_total average_z z_scale nth_z_scale color_object rgb_color_list smooth_gradation min_max_height_list ) (setq color_gradation_list '( ; r g b (0 0 255) (0 95 255) (0 205 255) (0 255 160) (30 255 0) (215 255 0) (255 225 0) (255 185 0) (255 100 0) (255 0 0) ) ; min_max_height_list '(-10 -4) ; smooth_gradation t ename_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "3dface,text,line,point,lwpolyline")))))) ) (cond ( (or (= "TEXT" (cdr (assoc 0 (entget (car ename_list))))) (= "POINT" (cdr (assoc 0 (entget (car ename_list))))) ) (setq min_z_total (cadddr (assoc 10 (entget (car ename_list)))) max_z_total min_z_total ) ) ( (= "3DFACE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11 12 13))) (entget (car ename_list))))) 4.0) max_z_total min_z_total ) ) ( (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (cdr (assoc 38 (entget (car ename_list)))) max_z_total min_z_total ) ) ( (= "LINE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11))) (entget (car ename_list))))) 2.0) max_z_total min_z_total ) ) ) (foreach ename ename_list (cond ( (or (= "TEXT" (cdr (assoc 0 (entget ename)))) (= "POINT" (cdr (assoc 0 (entget ename)))) ) (setq average_z (cadddr (assoc 10 (entget ename)))) ) ( (= "3DFACE" (cdr (assoc 0 (entget ename)))) (setq average_z (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11 12 13))) (entget ename)))) 4.0)) ) ( (= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))) (setq average_z (cdr (assoc 38 (entget ename)))) ) ( (= "LINE" (cdr (assoc 0 (entget ename)))) (setq average_z (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11))) (entget ename)))) 2.0)) ) ) (cond ( min_max_height_list (cond ( (and (>= average_z (car min_max_height_list)) (<= average_z (cadr min_max_height_list)) ) (vlax-ldata-put ename "Average_Z" average_z) ) ( t ) ) ) ( t (vlax-ldata-put ename "Average_Z" average_z) (if (< average_z min_z_total) (setq min_z_total average_z)) (if (> average_z max_z_total) (setq max_z_total average_z)) ) ) ) (if min_max_height_list (setq min_z_total (car min_max_height_list) max_z_total (cadr min_max_height_list) ) ) (setq z_scale (* 1e3 (- max_z_total min_z_total))) (cond ( (not (zerop z_scale)) (setq nth_z_scale (/ z_scale (1- (length color_gradation_list))) color_object (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))) ) (foreach ename ename_list (if (assoc "Average_Z" (vlax-ldata-list (vlax-ename->vla-object ename))) (progn (if smooth_gradation (setq rgb_color_list (get_mid_color (/ (* 1e3 (- (cdr (assoc "Average_Z" (vlax-ldata-list ename))) min_z_total)) nth_z_scale) color_gradation_list ) ) (setq rgb_color_list (nth (atoi (rtos (/ (* 1e3 (- (cdr (assoc "Average_Z" (vlax-ldata-list ename))) min_z_total)) nth_z_scale) 2 0)) color_gradation_list ) ) ) (vla-setrgb color_object (car rgb_color_list) (cadr rgb_color_list) (caddr rgb_color_list) ) (vla-put-colormethod (vla-get-truecolor (vlax-ename->vla-object ename)) accolormethodbyrgb) (vla-put-truecolor (vlax-ename->vla-object ename) color_object) ) (progn (vla-setrgb color_object 255 255 255) (vla-put-colormethod (vla-get-truecolor (vlax-ename->vla-object ename)) accolormethodbyrgb) (vla-put-truecolor (vlax-ename->vla-object ename) color_object) ) ) ) ) ( t (princ "\nZ coodinates are equal") ) ) (foreach ename ename_list (if (assoc "Average_Z" (vlax-ldata-list (vlax-ename->vla-object ename))) (vlax-ldata-delete (vlax-ename->vla-object ename) "Average_Z") ) ) (princ) ) ;*****************************************************************************************************************************************************************

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Wed, 22 Mar 2023 13:27:41 GMT

My God 😮 This is becoming the Holy Grail to my Color Grading Problem. @komondormrex you have done an out-standing job with this one.

The one and only limitation (I would not dare to call it a drawback at this stage) now is that if I select an upper and lower limit for elevation, the entities out of this range become white (255,255,255). (Screenshot attached)

As per my work requirements, it would be a lot better if all the entities with elevation greater than the upper limit become the same as the top-color (RED-in this case), and all those with elevation less than the lower limit become the same as the bottom-color (BLUE-in this case).

I certainly realize that I have already taken a lot of your time on this one, but if you can spare some time to resolve this I would be extremely thankful.

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Wed, 22 Mar 2023 13:51:17 GMT

you got it.

;***************************************************************************************************************************************************************** ; komondormrex, mar 2023 ;***************************************************************************************************************************************************************** (defun get_mid_color (color_value color_gradation_list / color_number) (setq color_number (atoi (rtos color_value))) (if (< color_number (1- (length color_gradation_list))) (mapcar '(lambda (color_1 color_2) (- color_1 (atoi (rtos (* (- color_value (fix color_value)) (- color_1 color_2)) 2 0)))) (nth color_number color_gradation_list) (nth (1+ color_number) color_gradation_list) ) (nth color_number color_gradation_list) ) ) ;***************************************************************************************************************************************************************** (defun c:a-la_z_gradient (/ color_gradation_list ename_list min_z_total average_z z_scale nth_z_scale color_object rgb_color_list smooth_gradation min_max_height_list count_index ) (setq color_gradation_list '( ; r g b (0 0 255) (0 95 255) (0 205 255) (0 255 160) (30 255 0) (215 255 0) (255 225 0) (255 185 0) (255 100 0) (255 0 0) ) ; min_max_height_list '(-10 -4) ; smooth_gradation t ename_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "3dface,text,line,point,lwpolyline")))))) ) (cond ( (or (= "TEXT" (cdr (assoc 0 (entget (car ename_list))))) (= "POINT" (cdr (assoc 0 (entget (car ename_list))))) ) (setq min_z_total (cadddr (assoc 10 (entget (car ename_list)))) max_z_total min_z_total ) ) ( (= "3DFACE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11 12 13))) (entget (car ename_list))))) 4.0) max_z_total min_z_total ) ) ( (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (cdr (assoc 38 (entget (car ename_list)))) max_z_total min_z_total ) ) ( (= "LINE" (cdr (assoc 0 (entget (car ename_list))))) (setq min_z_total (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11))) (entget (car ename_list))))) 2.0) max_z_total min_z_total ) ) ) (foreach ename ename_list (cond ( (or (= "TEXT" (cdr (assoc 0 (entget ename)))) (= "POINT" (cdr (assoc 0 (entget ename)))) ) (setq average_z (cadddr (assoc 10 (entget ename)))) ) ( (= "3DFACE" (cdr (assoc 0 (entget ename)))) (setq average_z (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11 12 13))) (entget ename)))) 4.0)) ) ( (= "LWPOLYLINE" (cdr (assoc 0 (entget ename)))) (setq average_z (cdr (assoc 38 (entget ename)))) ) ( (= "LINE" (cdr (assoc 0 (entget ename)))) (setq average_z (/ (apply '+ (mapcar 'cadddr (vl-remove-if-not '(lambda (group) (member (car group) '(10 11))) (entget ename)))) 2.0)) ) ) (cond ( min_max_height_list (cond ( (and (>= average_z (car min_max_height_list)) (<= average_z (cadr min_max_height_list)) ) (vlax-ldata-put ename "Average_Z" average_z) ) ( t (if (< average_z (car min_max_height_list)) (vlax-ldata-put ename "Average_Z_min" average_z) ) (if (> average_z (cadr min_max_height_list)) (vlax-ldata-put ename "Average_Z_max" average_z) ) ) ) ) ( t (vlax-ldata-put ename "Average_Z" average_z) (if (< average_z min_z_total) (setq min_z_total average_z)) (if (> average_z max_z_total) (setq max_z_total average_z)) ) ) ) (if min_max_height_list (setq min_z_total (car min_max_height_list) max_z_total (cadr min_max_height_list) ) ) (setq z_scale (* 1e3 (- max_z_total min_z_total))) (cond ( (not (zerop z_scale)) (setq nth_z_scale (/ z_scale (1- (length color_gradation_list))) color_object (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar 'acadver) 1 2))) count_index 0 ) (foreach ename ename_list (if (assoc "Average_Z" (vlax-ldata-list (vlax-ename->vla-object ename))) (progn (if smooth_gradation (setq rgb_color_list (get_mid_color (/ (* 1e3 (- (cdr (assoc "Average_Z" (vlax-ldata-list ename))) min_z_total)) nth_z_scale) color_gradation_list ) ) (setq rgb_color_list (nth (atoi (rtos (/ (* 1e3 (- (cdr (assoc "Average_Z" (vlax-ldata-list ename))) min_z_total)) nth_z_scale) 2 0)) color_gradation_list ) ) ) (vla-setrgb color_object (car rgb_color_list) (cadr rgb_color_list) (caddr rgb_color_list) ) (vla-put-colormethod (vla-get-truecolor (vlax-ename->vla-object ename)) accolormethodbyrgb) (vla-put-truecolor (vlax-ename->vla-object ename) color_object) ) (progn (if (assoc "Average_Z_min" (vlax-ldata-list (vlax-ename->vla-object ename))) (progn (vla-setrgb color_object (car (car color_gradation_list)) (cadr (car color_gradation_list)) (caddr (car color_gradation_list)) ) (vla-put-colormethod (vla-get-truecolor (vlax-ename->vla-object ename)) accolormethodbyrgb) (vla-put-truecolor (vlax-ename->vla-object ename) color_object) ) ) (if (assoc "Average_Z_max" (vlax-ldata-list (vlax-ename->vla-object ename))) (progn (vla-setrgb color_object (car (last color_gradation_list)) (cadr (last color_gradation_list)) (caddr (last color_gradation_list)) ) (vla-put-colormethod (vla-get-truecolor (vlax-ename->vla-object ename)) accolormethodbyrgb) (vla-put-truecolor (vlax-ename->vla-object ename) color_object) ) ) ) ) (princ (strcat "\rOf " (itoa (length ename_list)) " selected entities processed: " (itoa (setq count_index (1+ count_index))))) ) ) ( t (princ "\nZ coodinates are equal") ) ) (foreach ename ename_list (if (assoc "Average_Z" (vlax-ldata-list (vlax-ename->vla-object ename))) (vlax-ldata-delete (vlax-ename->vla-object ename) "Average_Z") ) (if (assoc "Average_Z_min" (vlax-ldata-list (vlax-ename->vla-object ename))) (vlax-ldata-delete (vlax-ename->vla-object ename) "Average_Z_min") ) (if (assoc "Average_Z_max" (vlax-ldata-list (vlax-ename->vla-object ename))) (vlax-ldata-delete (vlax-ename->vla-object ename) "Average_Z_max") ) ) (princ) ) ;*****************************************************************************************************************************************************************

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

Yasir.Aman — Wed, 22 Mar 2023 14:55:33 GMT

This is Ultimate. You cannot imagine to what extents this is going to be useful for me.

I don't know about your faith and beliefs @komondormrex , but I pray that may God strengthen your knowledge and may it be useful for you and everyone that needs it.

Salute!

Re: Color 3DFace entities according to their Z-value. (modify existing lisp code)

komondormrex — Thu, 23 Mar 2023 06:36:45 GMT

thank you) and you are very welcome)