Create polygons at intersections

[Shablab]

I have two polygons. One is my corridor (see white), and my other are disturbances (see red). I'm looking for a lisp that creates polygons everywhere where there is an overlap between the two (see green hatch). I currently have a lisp that gives me the area of the intersecting hatch but it is only a single use.

 

I want to be able to click the white boundary layer and then the red intersecting layer and have it make intersecting polygons between those two. 

[Lee Mac]

Try these programs by Stefan:

http://www.theswamp.org/index.php?topic=10371.msg514979#msg514979

[Shablab]

2 hours ago, Lee Mac said:

Try these programs by Stefan:

http://www.theswamp.org/index.php?topic=10371.msg514979#msg514979

Thank you Lee, the enclosed polygons is what I was looking for.  I am wondering now if there is a way to remove the other portion of the polygon that is outside of the "corridor".  What would be the best way to go about adding that to Stefan's lisp. 

I think the best bet would probably be just to use the "Maptrim" command subsequently and select the corridor.

EP - Enclosed polylines.lsp

Edited April 2, 2019 by Shablab

[ronjonp]

You can also use the boundary command and pick the areas you'd like to trace.

[Shablab]

@ronjonp That works but in some corridors I have over 50-100 intersecting polygons.

[lrm]

Here's a simple process that does not use LISP but relies on the Booleans and regions.

1. Select all the objects and convert them to regions then select all the red regions and union them together.  Note, to simplify the selection of the red regions just select all then type R (remove) and click on the white region.

2. Use the Boolean intersect on the two regions resulting in the shapes you want.

3. Use explode twice to get the outlines of the shapes.

 

 

[Shablab]

@lrm That works perfect, thank you very much. Did not know about intersecting with regions.

[ronjonp]

Based on code here this should do what you want:

(defun c:foo (/ r o n s)
  ;; RJP » 2019-04-03
  (cond	((and (setq s (ssget ":L" '((0 . "circle,ellipse,lwpolyline,spline"))))
	      (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	      (setq s (vl-remove-if-not '(lambda (x) (vlax-curve-isclosed x)) s))
	      (setq n (vlax-ename->vla-object (cdr (assoc 330 (entget (car s))))))
	      (setq s (vl-sort (mapcar 'vlax-ename->vla-object s)
			       '(lambda (a b) (> (vlax-curve-getarea a) (vlax-curve-getarea b)))
		      )
	      )
	 )
	 (setq r (car (vlax-invoke n 'addregion (list (car s)))))
	 (setq o (vlax-invoke n 'addregion (cdr s)))
	 (mapcar (function (lambda (x) (vla-boolean (vla-copy r) acintersection x))) o)
	 (mapcar 'vla-delete s)
	 (vla-delete r)
	)
  )
  (princ)
)
(vl-load-com)

 

Edited April 4, 2019 by ronjonp
updated code to include splines, ellipses, circles

[Shablab]

1 hour ago, ronjonp said:

Based on code here this should do what you want:

(defun c:foo (/ r o n s)
  ;; RJP » 2019-04-03
  (cond	((and (setq s (ssget ":L" '((0 . "lwpolyline"))))
	      (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	      (setq n (vlax-ename->vla-object (cdr (assoc 330 (entget (car s))))))
	      (setq s (vl-sort (mapcar 'vlax-ename->vla-object s)
			       '(lambda (a b) (> (vla-get-area a) (vla-get-area b)))
		      )
	      )
	 )
	 (setq r (car (vlax-invoke n 'addregion (list (car s)))))
	 (setq o (vlax-invoke n 'addregion (cdr s)))
	 (mapcar (function (lambda (x) (vla-boolean (vla-copy r) acintersection x))) o)
	 (mapcar 'vla-delete s)
	 (vla-delete r)
	)
  )
  (princ)
)
(vl-load-com)

 

Thank you Ron, that is exactly what I was in search of.

[ronjonp]

18 minutes ago, Shablab said:

Thank you Ron, that is exactly what I was in search of.

Glad to help

[BIGAL]

ronjonp If you have a circle does not do anything to it. Nicely done though circle may never exist.

[ronjonp]

12 hours ago, BIGAL said:

ronjonp If you have a circle does not do anything to it. Nicely done though circle may never exist.

You are correct .. updated the code above to do a few more objects

 

[BIGAL]

Very nice work ronjonp  we work to cheap keep that version as a paid for version.