Fill in several outlines with separates hatchings

[Nikon]

Is it possible to use lisp to shade selected outlines (several at once) with separates hatchings Solid?
There are many polylines (rectangles) that need to be filled with separates hatchings...

How can this be applied to multiple outlines:
(vl-cmdf "_.-hatch" "_s" r "" "_p" "SOLID" "" "" "") 

Edited September 10 by Nikon

[rlx]

 

 

 

 

just use toggle 'Create separate hatches'

 

 

[Nikon]

1 minute ago, rlx said:

just use toggle 'Create separate hatches'

I know this, but I have a lot of outlines in my drawing, and it takes a very long time to highlight each of them...

[rlx]

(defun c:t1 ( / al ss )
  (setq al (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object))))
  (if (setq ss (ssget "_X" (list '(0 . "LWPOLYLINE"))))
    (vlax-for o (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
      (setq h (vla-addhatch (vlax-get al 'block) acHatchPatternTypePredefined "SOLID" :vlax-true))
      (vlax-invoke h 'AppendOuterLoop (list o))(vlax-invoke h 'Evaluate)
    )
  )
  (princ)
)

(defun c:t2 ( / al ss)
  (setq al (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object))))
  (princ "\nSelect objects to apply solid hatch to : ")
  (if (setq ss (ssget (list '(0 . "LWPOLYLINE"))))    
    (vlax-for o (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
      (setq h (vla-addhatch (vlax-get al 'block) acHatchPatternTypePredefined "SOLID" :vlax-true))
      (vlax-invoke h 'AppendOuterLoop (list o))(vlax-invoke h 'Evaluate)
    )
  )
  (princ)
)

 

[Nikon]

17 hours ago, rlx said:

(defun c:t2 ( / al ss)
  (setq al (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object))))
  (princ "\nSelect objects to apply solid hatch to : ")
  (if (setq ss (ssget (list '(0 . "LWPOLYLINE"))))    
    (vlax-for o (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
      (setq h (vla-addhatch (vlax-get al 'block) acHatchPatternTypePredefined "SOLID" :vlax-true))
      (vlax-invoke h 'AppendOuterLoop (list o))(vlax-invoke h 'Evaluate)
    )
  )
  (princ)
)

@rlx thank you very much!!! It will help me a lot.

Edited September 11 by Nikon

[BIGAL]

Post a dwg. Should be able to use Hatchb.lsp to make a boundary and get the points of the boundary, if its more than 4 vertices or small sides are different lengths then it's not really a pline shape.

[Nikon]

12 hours ago, BIGAL said:

Post a dwg. Should be able to use Hatchb.lsp to make a boundary and get the points of the boundary, if its more than 4 vertices or small sides are different lengths then it's not really a pline shape.

I am trying to convert (using the program SOLID_PLINE_HATCH_TO_PLINE) the created hatches into a polyline with global width=hatching width, but an entry is displayed on the command string:
"The outline of the hatching is formed not only by a polyline".

If the hatching is created by the autocad command, then the SOLID_PLINE_HATCH_TO_PLINE program works...

PL_HATCH.dwg Solid_pline_hatch_to_pline.fas.rar

Edited September 11 by Nikon

[BIGAL]

Sorry no help to existing code  if your using a FAS file. I use Bricscad mostly now and fas is not supported.

 

This is close to what you want, I have not looked at color of hatch but that could be added. Change layer name, the rectang around the hatch is erased, the hatch is still there on Hatch layer, again could be erased.

 

You were lucky did the d1 d2 bit yesterday for another post.

 

; https://www.cadtutor.net/forum/topic/90914-fill-in-several-outlines-with-separates-hatchings/
; Convert a rectang to a pline with width.
: By Alan H Sep 2024

(defun C:Rect2pl  ( / sspl co-ord x mp1 mp2 d1 d2)

(command "-layer" "M" "HATCH2" "")

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq sspl (ssget (list (cons 0 "LWPOLYLINE")(cons 410 (getvar 'ctab)))))
(setvar 'clayer "HATCH2")
(repeat (setq x (sslength sspl))
 (setq plent (ssname sspl (setq x (1- x))))
 (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
 (setq d1 (distance (car co-ord)(cadr co-ord)))
 (setq d2 (distance (cadr co-ord)(caddr co-ord)))
 (if (< d1 d2)
 (progn
  (setq mp1 (mapcar '* (mapcar '+ (nth 0 co-ord) (nth 1 co-ord)) '(0.5 0.5)))
  (setq mp2 (mapcar '* (mapcar '+ (nth 2 co-ord) (nth 3 co-ord)) '(0.5 0.5)))
  (command "pline" mp1 "W" d1 d1 mp2 "")
 )
 (progn
  (setq mp1 (mapcar '* (mapcar '+ (nth 1 co-ord) (nth 2 co-ord)) '(0.5 0.5)))
  (setq mp2 (mapcar '* (mapcar '+ (nth 3 co-ord) (nth 0 co-ord)) '(0.5 0.5)))
  (command "pline" mp1 "W" d2 d2 mp2 "")
 )
 )
 (command "erase" plent "")
)

(princ)
)

 

Edited September 12 by BIGAL

[Nikon]

Mr. @BIGAL This is an amazing program!!!  I couldn't find this solution for a long time... Thanks a lot! 

A very good start to the day! Thanks for Rect2pl.

Edited September 12 by Nikon

[BIGAL]

No worries as I had solved already the shortest side it was easy to do.