Rainbow coloring AHN

;==============================================
; 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)
Dutch NL English EN German DE