LSP for creating multiple colored hatches

[Theking20212030]

Hi all, I am in desperate need for lsp that create multiple hatches for multiple closed  different colored polylines so that the hatch would match the same COLOR (RGB not index) and ELEVATION of that polyline, I have found one that matches the hatch's elevation to the polyline but no luck with the color? Please help, I am desperate! Thanks in advance!

[Steven P]

Are you able to post the LISP you found, it might be that adding colour is a simple change to that rather than using 2 LISPs

[Theking20212030]

This one elevates the hatch to the boundary elevation:

(defun c:foo (/ lw s v)
  (if (setq s (ssget ":L" '((0 . "HATCH"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (and (setq lw (cdr (assoc 330 (reverse (entget e)))))
	   (setq v (cdr (assoc 38 (entget lw))))
	   (vla-put-elevation (vlax-ename->vla-object e) v)
      )
    )
  )
  (princ)
)

 and this one creates multiple hatches each by boundary (closed polylines) colors, except the hatches it creates can't be moved by the above lsp, AND the colors are approximated index colors (not RGB):

(vl-load-com)

;; See thread here: https://www.cadtutor.net/forum/topic/77467-hatch-to-each-of-the-closed-polylines-match-the-colour-layer/

;; Program to hatch closed polylines to match the layer and colour of each selection polyline.
;; Answer by fuccaro and added undo handling and changed the selection method by myself (3dwannab)

;; First written on 2023.05.11

(defun c:HBC nil (c:HH_Boundary_Colour))

(defun c:HH_Boundary_Colour (/ *error* acDoc hatch i p pl ss1 var_cmdecho var_osmode) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))

  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (setq ss1 (ssget ":L" (list '(0 . "LWPOLYLINE") '(70 . 1))))
  (repeat (setq i (sslength ss1)) 
    (setq p (ssname ss1 (setq i (1- i))))
    (setq pl    (entget p)
          lay   (assoc 8 pl)
          color (assoc 62 pl)
    )
    (command "_hatch" "s" p "")
    (setq hatch (entget (entlast))
          hatch (subst lay (assoc 8 hatch) hatch)
    )

    (cond 
      (color (setq hatch (append hatch (list color))))
    )

    (entmod hatch)
  )

  (*error* nil)
  (princ)
)

(princ (strcat " \n: ------------------------------\n'Hatch_Boundary_Colour.lsp' Loaded | Invoke by typing 'HH_Boundary_Colour' or 'HBC'.\n: ------------------------------\n"))
(princ)

 

[Theking20212030]

I guess the first lsp (foo) works only on associative hatches

[BIGAL]

This has been asked before you can get max min elevation and set a range of colors. A better way than just using a color a your limited to 254 colors. CIv3D has this function built in display contours via color.