Create hatch based on the envelope

Hello

I have a block containing polyline "Test*".

What would I like to do?

1. Get the shape of the polyline

2. Divide the shape into 2 parts

3. Create a hatch with an RGB color and individual layer (2 shape) (see picture)

Is it possible?

Are you just avoiding doing manually ?

As an automation pretty easy a lisp using this method, do you know how to do lisp ?

pick pt1

pick pt2

pick pt3

pick pt4

line pt1 pt2

-hatch pt1 pat1

-hatch pt2 pat2

I want to use autolisp. But I have a problem. I don't know how create point list (calculate point of division and get point list from the block).

My extra question was aimed at do you want the true area1=area2 if so then probably none of the images are correct or just I want to pick two points with some rules like mid of another line.

The lisp code is really take what I have already posted converted to lisp.

Please post about extra question it complicates things, if not required a1=a2 then its a few minutes to code.

Hello

The picture are sketches (please no suggest)

I assumed such a scenario.

Search max left/down corner.

Get length polyline and split to 2 part.

Set the point and create two obiect.

Maybe this is bad assumption..

Give this a try. DEMO.

(defun c:foo (/ _addhatch _bnd a ao b d doc e ll mp o s sp ur vc vs)
 (defun _addhatch (e c sp l / h)
   (if	(setq h (vla-addhatch sp achatchpatterntypepredefined "SOLID" :vlax-false))
     (progn (vlax-invoke h 'appendouterloop (list e))
     (vla-put-color h c)
     (vla-evaluate h)
     (vla-update h)
     (entmod (append (entget (vlax-vla-object->ename h)) (list (cons 8 l))))
     h
     )
   )
 )
 (defun _bnd (p l / e)
   (setq e (entlast))
   (command "_.-boundary" p "")
   (cond ((not (equal e (entlast)))
   (entmod (append (entget (setq e (entlast))) (list (cons 8 l))))
   (vlax-ename->vla-object e)
  )
   )
 )
 (if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
   (progn
     (setq doc (vla-get-activedocument (setq ao (vlax-get-acad-object))))
     (vla-startundomark doc)
     (setq sp (vlax-get doc
		 (cond ((= 1 (getvar 'cvport)) 'paperspace)
		       ('modelspace)
		 )
       )
     )
     (vla-put-lock (vlax-ename->vla-object (tblobjname "layer" (getvar 'clayer))) :vlax-false)
     (setq vc (getvar 'viewctr))
     (setq vs (getvar 'viewsize))
     (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(setq o (vlax-ename->vla-object b))
(if
  (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur))))
       (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
       (setq e (entmakex (list '(0 . "line") '(8 . "tempfoo") (cons 10 ll) (cons 11 ur))))
  )
   (progn (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.)) ll ur))
	  (vlax-invoke ao 'zoomcenter mp (setq d (distance ll ur)))
	  (and (setq a (_bnd (list (+ (car mp) (* d 0.1)) (cadr mp)) "BoundaryA"))
	       (_addhatch a 1 sp "HatchA")
	  )
	  (and (setq b (_bnd (list (- (car mp) (* d 0.1)) (cadr mp)) "BoundaryB"))
	       (_addhatch b 3 sp "HatchB")
	  )
   )
)
(and e (entdel e))
     )
     (vla-endundomark doc)
     (vlax-invoke ao 'zoomcenter vc vs)
   )
 )
 (princ)
)

Cool stuff, Ron!

Few questions though:

Is zooming to the object is necessary?

If it is: maybe with zoomextents and zoomprevious methods would be faster.

Does anyone know if the evaluation of the hatch is important? (vla-Evaluate ..)

Because I used the AddHatch method before without the need of it.

Cool stuff, Ron!

Few questions though:

Is zooming to the object is necessary?

If it is: maybe with zoomextents and zoomprevious methods would be faster.

 

Does anyone know if the evaluation of the hatch is important? (vla-Evaluate ..)

Because I used the AddHatch method before without the need of it.

I zoom to the object for speed with the "boundary" command so it does not look at the entire drawing .. try it Guess I could call (bpoly pt) too .. but think that speed would still be an issue with many objects on screen.

*EDIT .. just tested and it's much slower.

I zoom to the object for speed with the "boundary" command so it does not look at the entire drawing .. try it Guess I could call (bpoly pt) too .. but think that speed would still be an issue with many objects on screen.

 

*EDIT .. just tested and it's much slower.

Thanks for confirming, Ron.

I have a problem with "clone of CAD" - BricsCad

Is it possible to avoid it somehow

"; ----- Error around expression -----

(BPOLY "P")

;

; error : no function definition ; expected FUNCTION at [eval]

"

I can test in Bricscad tomorrow.

ok thank you wery much

One additional question.

Function looks great but in my case, polline existing inner block.

Is it possible to somehow extract this outline

Interesting Ronjonp nice effort, that is one solution but looking at the image is the answer start from setting an actual corner point for a swing line and again is area1 =area2 ? This needs an iteration to rotate till the areas are within a tolerance ie equal.

I believe jan_ek you need to confirm a bit more clearly the rules about what you want. Also the image is right to left and Ronjonp code is the other way when I tested ?

Hello, I assumed solution below, but the proposed solutions also seem correct

My code does not do that .. sorry. At least you have a start.

*I updated the code to work in Bricscad as is.

.... Also the image is right to left and Ronjonp code is the other way when I tested ?

I had it the other way until post #5: "Search max left/down corner."

Hello, I assumed solution below, but the proposed solutions also seem correct

 

FWIW .. A post like this in the beginning helps. The more info you can provide the more likely you'll get the answer you need.

FWIW to find the opposite point:

(defun OppositePtOnCurve ( curve p / dis )
 (vlax-curve-getPointAtDist curve
   (rem
     (+
       (vlax-curve-getDistAtPoint curve p)
       (* 0.5 (setq dis (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))))
     )
     dis
   )
 )
); defun OppositePtOnCurve

Test function:

(
 (lambda (x / args p2)
   (and x 
     (setq args (cons (car x) (list (apply 'vlax-curve-getClosestPointTo (append x '(t))))))
     (setq p2 (apply 'OppositePtOnCurve args))
     (entmakex (list (cons 0 "LINE")(cons 10 (cadr args))(cons 11 p2)))
   )
 )
 (nentselp "\nPick a closed curve:")
)

Nice Grrr

Nice Grrr

Thanks Ron, might help you if you decide to update your code.