Hatch on same layer as Pline

[gregmorris234]

Hi All,

 

Wondering if someone has a LISP routine. I had a little scour of the web but I don't think I could get the wording right for finding what I need.

 

I need to hatch some polylines, which are on different layers, in one batch but for the hatches to match the layer of the boundary they are set within? This possible?

 

Cheers

 

Greg

[dlanorh]

Yes.

[ronjonp]

Try this quickie:

(defun c:foo (/ h s)
  ;; RJP » 2020-08-11
  ;; Match hatch to associative boundary layer
  (if (setq s (ssget "_X"))
    (foreach x (mapcar 'cadr (ssnamex s))
      (and (setq h (cdr (assoc 330 (entget x))))
	   (= "HATCH" (cdr (assoc 0 (entget h))))
	   (entmod (append (entget h) (list (assoc 8 (entget x)))))
      )
    )
  )
  (princ)
)

 

[gregmorris234]

13 minutes ago, ronjonp said:

Try this quickie:

(defun c:foo (/ h s)
  ;; RJP » 2020-08-11
  ;; Match hatch to associative boundary layer
  (if (setq s (ssget "_X"))
    (foreach x (mapcar 'cadr (ssnamex s))
      (and (setq h (cdr (assoc 330 (entget x))))
	   (= "HATCH" (cdr (assoc 0 (entget h))))
	   (entmod (append (entget h) (list (assoc 8 (entget x)))))
      )
    )
  )
  (princ)
)

 

Hi Ronjonp,

 

Thank you for a very swift response. I couldn't get this one to work unfortunately.

 

I'm not sure when I am supposed to run this routine, as in before I hatch or after, or do I hatch the boundaries first then use this as a kind of match properties tool? 

 

Appreciate your help

 

Greg

[ronjonp]

Post a sample drawing. The only thing I can think of is your hatch is not associative.

[gregmorris234]

I think I've figured out where I was going wrong. I was selecting multiple polyline boundaries first then turning them into separate hatches through Hatchedit. Doing it this way didn't seem to play nice with the LISP. I realise now that you just run that routine and it does all hatches, which I think is what confused me.

 

Doing it this way is likely to be more pain than it's worth on my drawing and I think match props is going to be easier but I do very much appreciate your help! 

[ronjonp]

18 minutes ago, gregmorris234 said:

I think I've figured out where I was going wrong. I was selecting multiple polyline boundaries first then turning them into separate hatches through Hatchedit. Doing it this way didn't seem to play nice with the LISP. I realise now that you just run that routine and it does all hatches, which I think is what confused me.

 

Doing it this way is likely to be more pain than it's worth on my drawing and I think match props is going to be easier but I do very much appreciate your help! 

@gregmorris234 If you want to select the boundaries you can use this ... easy modification.

(defun c:foo (/ h s)
  ;; RJP » 2020-08-11
  ;; Match hatch to associative boundary layer
  (if (setq s (ssget))
    (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (and (setq h (cdr (assoc 330 (entget x))))
	   (= "HATCH" (cdr (assoc 0 (entget h))))
	   (entmod (append (entget h) (list (assoc 8 (entget x)))))
      )
    )
  )
  (princ)
)

 

Edited August 11, 2020 by ronjonp

[dlanorh]

Another

 

(defun rh:hatch_ent (ent spc hs lst / elst typ obj ok h_obj bdy)
  (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename obj)))
  (setq el (entget ent) typ (cdr (assoc 0 el)) fuzz 1.0e-8)
  (cond ( (or (vl-position typ (list "CIRCLE" "REGION"))
              (and (= typ "ELLIPSE") (equal 0.0 (cdr (assoc 41 el)) fuzz) (equal (* pi 2.0) (cdr (assoc 42 el)) fuzz))
              (and (vl-position typ (list "LWPOLYLINE" "POLYLINE"))
                   (or (= :vlax-true (vlax-curve-isclosed ent))
                       (equal (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent) fuzz)
                   );end_or
              );end_and
          );end_or
          (setq h_obj (vlax-invoke spc 'addhatch acHatchObject hs :vlax-true)
                bdy (vlax-make-safearray vlax-vbObject '(0 . 0))
          );end_setq
          (vlax-safearray-put-element bdy 0 obj)
          (vla-appendouterloop h_obj bdy)
          (vla-evaluate h_obj)
          (mapcar '(lambda (x) (vlax-put h_obj (car x) (cadr x))) lst)
        )
  );end_cond
);end_defun

(defun c:htest (/ *error* c_doc c_spc sv_lst sv_vals ans ss sent el hpat hlst cnt lst pent )

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
    (princ)
  );end_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))

  (initget "Default Select")
  (setq ans (cond ( (getkword "\nSelect Existing Hatch for pattern and Scale or Default (current settings) : ? [Default/Select] <Select> ")) ("Select")))
  (cond ( (= ans "Select")
          (while (not sent)
            (prompt "\nSelect Hatch for Pattern/Scale : ")
            (setq ss (ssget "_+.:E:S" '((0 . "HATCH"))))
            (cond (ss
                    (setq sent (ssname ss 0)
                          el (entget sent)
                          hpat (cdr (assoc 2 el))
                          ss nil
                    );end_setq
                    (cond ( (= (cdr (assoc 70 el)) 0)
                            (mapcar '(lambda (x y) (setq hlst (cons (list x (cdr (assoc y el))) hlst))) (list 'patternscale 'patternangle) (list 41 52))
                          )
                    );end_cond
                  )
            );end_cond
          )
        )
        (t
          (setq hpat (getvar 'hpname))
          (mapcar '(lambda (x y) (setq hlst (cons (list x (getvar y)) hlst))) (list 'patternscale 'patternangle) (list 'hpscale 'hpang))
        )
  );end_cond

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq lst nil
                  el (entget (setq pent (ssname ss (setq cnt (1- cnt)))))
                  lst (cons (list 'layer (cdr (assoc 8 el))) lst)
            )
            (rh:hatch_ent pent c_spc hpat (reverse (append lst hlst)))
          )
        )
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
)

 

You can select an existing hatch pattern to match or go with the current settings.