Leaderboard

I know our flood engineer would spend hours making models of surface and pipe networks. Then ran Tuflow. https://www.tuflow.com/ We are talking here big areas. In particular for suburb subdivision design. Sorry can not amke any comment about how good the software is. It was at times compared to real world on ground flood level checks. Here is in AUS we have had like 4 flood seasons in one year. Flood levels measured in metres, water going through 1st floor of houses.

My code above matches colors as well as gradients

@leonucadomi Give this a try: (defun c:foo (/ a b e h hp p x) ;; RJP » 2022-09-08 (cond ((and (setq e (car (entsel "\nPick source hatch: "))) (= "HATCH" (cdr (assoc 0 (entget e)))) (setq b (assoc 2 (entget e))) (setq e (vlax-ename->vla-object e)) (setq a (mapcar '(lambda (x) (list x (vlax-get e x))) '(associativehatch backgroundcolor elevation entitytransparency gradientangle gradientcentered gradientcolor1 gradientcolor2 gradientname hatchobjecttype hatchstyle isopenwidth layer linetype linetypescale lineweight material origin patternangle patterndouble patternscale patternspace plotstylename truecolor visible ) ) ) ) (setq hp (getvar 'hpname)) (setvar 'hpname (cdr b)) (while (setq p (getpoint)) (setq h (entlast)) (command "_.bhatch" p "") (cond ((not (equal h (setq h (entlast)))) (setq h (vlax-ename->vla-object h)) (foreach x a (vl-catch-all-apply 'vlax-put (list h (car x) (cadr x)))) ;; patternname (RO) cannot be set via vla for some reason ? ;; (setq h (entget (vlax-vla-object->ename h))) ;; (entmod (subst b (assoc 2 h) h)) ) ) ) (setvar 'hpname hp) ) ) (princ) )

(vl-load-com) (defun c:classify ( / ss ssl index obj color linetype linetypescale str layertable newlayername) (princ "\n select object to classify") (setq layertable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) (if (setq ss (ssget)) (progn (setq ssl 0) (setq ssl (sslength ss)) (setq index 0) (setq str "") (repeat ssl (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ss index)))))) (setq color (vla-get-color obj)) (if (= color 256) ; if by layer (setq color (cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj))))) ) (setq color (vl-princ-to-string color)) (setq linetype (vl-princ-to-string (vla-get-linetype obj))) (if (= linetype "ByLayer") ; if by layer (setq linetype (cdr (assoc 6 (tblsearch "LAYER" (vla-get-layer obj)) ) ) ) ) (setq linetype (vl-princ-to-string linetype)) (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj))) (setq str (strcat "color-" color "_lt-" linetype "_lts-" linetypescale)) (if (= (tblsearch "LAYER" str) nil) (progn (setq newlayername (vla-add layertable str)) (vla-put-color newlayername color) (vla-put-linetype newlayername linetype) ;(vla-put-linetypescale newlayername linetypescale) (vlax-put-property obj 'layer str) (vla-put-color obj 256) (vla-put-linetype obj "ByLayer") ); end of progn (progn (setq newlayername (vla-item layertable str)) (vlax-put-property obj 'layer str) (vla-put-color obj 256) (vla-put-linetype obj "ByLayer") ); end of progn ); end of if (setq index (+ index 1)) );end of repeat );end of progn );end of if (princ) );end of defun how about approach like this. - code updated, layer cannot have linetype scale value. my mistake. works like below