;==============================================
; COLOURBY256.LSP (omgekeerde kleurverdeling)
;----------------------------------------------
; Kleurt LINE-, 2D- en 3D-polylines op basis van hun hoogte.
; Lage hoogte = kleur 255
; Hoge hoogte = kleur 1
;
; Voor LINE: gemiddelde Z van start- en eindpunt
; Voor 2D polyline: elevation
; Voor 3D polyline: gemiddelde Z van vertexen
;
; Auteur: GPT-5 (voor Lammerts Engineering)
; Datum: 2025-10-21
;==============================================
(defun getEntityHeight (obj / objType elev zlist ent vtx edata zval)
(setq objType (vla-get-objectname obj))
(cond
((= objType "AcDbLine")
(setq p1 (vlax-get obj 'StartPoint)
p2 (vlax-get obj 'EndPoint))
(/ (+ (caddr p1) (caddr p2)) 2.0)
)
((= objType "AcDbPolyline")
(vla-get-elevation obj)
)
((= objType "AcDb3dPolyline") ; let op: kleine ādā
(setq zlist '())
(setq ent (vlax-vla-object->ename obj))
(setq vtx (entnext ent))
(while vtx
(setq edata (entget vtx))
(if (= (cdr (assoc 0 edata)) "VERTEX")
(progn
(setq zval (cdr (assoc 30 edata)))
(if (numberp zval)
(setq zlist (cons zval zlist))
)
)
)
(setq vtx (entnext vtx))
)
(if (and zlist (> (length zlist) 0))
(/ (apply '+ zlist) (length zlist))
0.0
)
)
(t 0.0)
)
)
(defun c:COLOURBY256 ( / ss n obj elev elev-list min-elev max-elev range color objType)
(vl-load-com)
(prompt "\nSelecteer LINE of polyline objecten om te kleuren: ")
(setq ss (ssget "_:L")) ; selecteer alles zichtbaar
(if ss
(progn
(setq n 0 elev-list '())
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss n)))
(setq elev (getEntityHeight obj))
(setq elev-list (cons elev elev-list))
(setq n (1+ n))
)
(setq min-elev (apply 'min elev-list))
(setq max-elev (apply 'max elev-list))
(setq range (- max-elev min-elev))
(if (equal range 0.0 1e-6)
(progn
(prompt "\nAlle objecten hebben dezelfde hoogte ā alles krijgt kleur 7.")
(setq n 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss n)))
(vla-put-color obj 7)
(setq n (1+ n))
)
)
(progn
(prompt (strcat
"\nMinimum hoogte: " (rtos min-elev 2 3)
" | Maximum hoogte: " (rtos max-elev 2 3)
" | Kleurverdeling: omgekeerd (laag = 255, hoog = 1)"
))
(setq n 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss n)))
(setq elev (getEntityHeight obj))
(setq color (fix (- 255.0 (* 254.0 (/ (- elev min-elev) range)))))
(if (> color 255) (setq color 255))
(if (< color 1) (setq color 1))
(vla-put-color obj color)
(setq n (1+ n))
)
)
)
(prompt "\nKleuring voltooid (omgekeerd).")
)
(prompt "\nGeen geschikte objecten geselecteerd.")
)
(princ)
)
(princ "\nType COLOURBY256 om LINEs en polylines op hoogte te kleuren (omgekeerd).")
(princ)