Create hatch based on the envelope

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:")
)

wow , that's super!

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

The OP wants equal areas on each side and the shapes of the examples above need more than just the opposite side. Although this example does not have equal areas and your code is pretty close ...

wow , that's super!

Thanks, I'll be happy if this would help in your work.

The OP wants equal areas on each side and the shapes of the examples above need more than just the opposite side. Although this example does not have equal areas and your code is pretty close ...

Oh, after seeing the image the task seems very hard.

However, if not restricted to divide the geometry with a straight line, the answer (perhaps) would be to:

• Get Base and opposite Point on the curve
  
• Divide into n amount of segments the left/right side of the curve and project lines to the right/left side
  
• Extract mids from the projected lines and construct a point list (starting from base pt and finishing to the opposite pt)
  
• Entmake a (temporary) polyline and bpoly on the right and on the left side
  

If you visualise that proccess in your head the result would be a interpolated curve, between the two splitted parts of the original closed polyline.

As I posted almost in 1st post you pick a point draw a line using "OppositePtOnCurve" as a 1st approximation, great code idea by the way, was going to use pick a pt. Then compare an area on left and right, user picks left and right to simplify coding,using 2 defuns one plus the other minus rotate the line a very small amount re-do the areas compare and keep going till area1=area2 with a tolerance else it will take a long time using 0.000000001 as rotation. Use intersectwith and bpoly.

Just a side note this is a function for land surveying when creating allotments, the difference is you enter area and it rotates to this answer. 1/2 total area. This code may already exist I will do a google.

One exception and like what has been shown already is where the line cross pline edges it will probably give incorrect answer.

Have to do something else right now for a few hours else would have had a go.

Using a pick point as the base. It started to rain had some time. This is a work in progress the line I think is bouncing back and forth as it approaches the tolerance. It works but is not super fast due to trying to get to tolerance. If you want to try it change the step size and tolerance.

; Code by Grrr Feb 2018
(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:

; random point on say pline
(defun randpt ()
(
 (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:")
)
)

; BIGAL addition Feb 2018
; use this with above for a pick point option 

(defun ptoppositept ( / ss )
(setq oldsnap (getvar 'osmode))
(setq pt1 (getpoint "Pick point"))
(setq ss (SSget pt1))
(setq pt2 (OppositePtOnCurve (vlax-ename->vla-object  (ssname SS 0 )) pt1))
(setvar "osmode" 0)
(Command "LINE" pt1 pt2 "")
(setq lobj (entlast))
)

;(entmakex (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)))

(defun make2area ( / bp1 bp2)
(setq bp1 (command "bpoly" pt3 ""))
(setq a1 (vla-get-area (vlax-ename->vla-object (entlast))))
(Command "erase" "L" "")
(setq bp2 (command "bpoly" pt4 ""))
(setq a2 (vla-get-area (vlax-ename->vla-object (entlast))))
(Command "erase" "L" "")
(setq diff (- a1 a2))
)

; starts here
(ptoppositept)
(setq pt3 (getpoint "Pick a point on side 1")) ; replace with auto pt3 90 to line
(setq pt4 (getpoint "Pick a point on side 2"))
(setq oldaunits (getvar "aunits"))
(setq oldaang (getvar "angdir"))
(setvar 'aunits 0)
(setvar 'angdir 1)
(make2area)

(setvar 'cmdech 0)
(while (> (abs (- a1 a2)) 0.1)
(if (> diff 0.0)
(command "rotate" lobj "" Pt1 0.00005)
(command "rotate" lobj "" Pt1 -0.00005)
)
(make2area)
(princ (strcat "\n" (rtos diff 2 2)))
)

(setvar 'osmode oldsnap)
(setq oldaunits (getvar "aunits"))
(setq oldaang (getvar "angdir"))

Forgot to add hatches, but any way there is a mathematical answer using cordinates for area calculations need to rework the answer backwards to solve the xy pt by sliding along a line. Then it will be an instant answer. Yeah I am not a mathematician. Will think a bit harder.

https://www.mathsisfun.com/geometry/area-irregular-polygons.html

This may be very much like an index answer using a 1/2 offset distance to calculate point. Think about this 10,000 items indexed 14 goes to get the one you want, compare each one is 9999 goes, maybe less if it finds it before end.

Forgot to add hatches, but any way there is a mathematical answer using cordinates for area calculations need to rework the answer backwards to solve the xy pt by sliding along a line. Then it will be an instant answer. Yeah I am not a mathematician. Will think a bit harder.

 

https://www.mathsisfun.com/geometry/area-irregular-polygons.html

I remember we had similar exercise in our geodesy class from the university (we were doing it manually and I don't remember anything except the polygon and the coordinate grid).

I wanted to test the solution proposed by - ronjonp.

I encountered two problems.

1. How to correctly convert the polyline's coordinates (maybe I do not need to draw a polyline ?)

2. Objects in the drawing affect the hatching

(defun c:lha ( / sel$ lname$ lp$ )
(setq lname$ (list "TES" "TEST2" "TEST8"))
(setq sel$ (car (entsel "select block" )))
(setq sel$  (getentityinsideblock sel$ ))
(if sel$ 
 (progn
  (setq lp$ (car (getpollyline sel$ lname$)))
  (princ (car(car (cdr lp$) )))
  (command "_pLine"  (car (cdr lp$) ) "c") 
  (foo (entlast))
 )
)
)

(defun getpollyline  ( entitylist namepoly / ent$ lst$ a$ )
(foreach $ entitylist
;(princ (strcase (cdr (assoc 0 (setq a$ (entget $))))))
 (if (= (strcase (cdr (assoc 0 (setq a$ (entget $))))) "LWPOLYLINE")
  (progn
   (if (member (strcase (cdr (assoc 8 a$))) namepoly)    
    (setq lst$ (cons (list $ (getCoord  $)) lst$))
   )
  )
 )
)
lst$
)
(defun  getentityinsideblock ( blockn / Ename$ el$)
(if (setq Ename$ (TBLOBJNAME "BLOCK" (CDR (ASSOC 2 (ENTGET blockn )))))
 (reverse
  (while (setq Ename$ (entnext Ename$))
   (setq el$ (cons Ename$ el$))
  )
 )
)
(reverse el$)
)
; by: Lee Mac http://www.cadtutor.net/forum
(defun getCoord  (pl / pl)
 (vl-load-com)
 
 (or (eq 'VLA-OBJECT (type pl))
     (setq pl (vlax-ename->vla-object pl)))

 (if (eq "AcDbPolyline" (vla-get-ObjectName pl))
   (vlax-list->2D-point
     (vlax-get pl 'Coordinates)) nil))
; by: Lee Mac http://www.cadtutor.net/forum
(defun vlax-list->2D-point  (lst)
 (if lst
   (cons (list (car lst) (cadr lst))
         (vlax-list->2D-point (cddr lst)))))

;by:  ronjonp 
;http://www.cadtutor.net/forum/showthread.php?102868-Create-hatch-based-on-the-envelope
(defun  foo (ent / _addhatch _bnd a ao b d doc e ll mp o s sp ur vc vs)
(setq s  (ssadd))
(setq s (ssadd ent s ))


 (if  s 
   (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)
)
(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)
     )
   )
 )

Jan_ek did you have a look at what I Posted my code is further down the page after Grrr's.

I wanted to test the solution proposed by - ronjonp.

I encountered two problems.

1. How to correctly convert the polyline's coordinates (maybe I do not need to draw a polyline ?)

2. Objects in the drawing affect the hatching

The boundary command takes all objects into account when creating the boundary.

Something as simple as this will get your polyline coords:

(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))

HERE is some code you could use to get areas from a list of points too.

The way to go is to bounce 1 pt using a narrowing algorithm as I mentioned already about index's use the algorithm as per the mathamatical link, bounce the point as follows.

Find approx point, make new point 1/2 way say start newpt check area bounce other side 1/2 way reset both points bounce 1/2 again all the time sliding along line, keep bouncing 1/2 way this is like a pyramid closing in on a point, its very fast compared to the angle version already posted.

Hello

I was gone and only now I am starting to write.

Thanks for answers