Solved: Create a closed polygon covering the 4 endpoints of any 2 lines or polylines

ancrayzy · ‎04-18-2024

I try to write a lisp to create a closed polygon outside 4 endpoints of any 2 lines or polylines but it didn't work.

Attached is a screenshot and sample CAD file.
There are somthing wrong?

I found a similar Lee Mac autolisp but it doesn't work in my case

https://www.lee-mac.com/outlineobjects.html

Thanks for all the consideration.

(defun c:OuterPolygon (/ lines p1 p2 p3 p4 poly)
  (setq lines (ssget '((0 . "LINE"))))
  (if (= (sslength lines) 2)
    (progn
      (setq line1 (vlax-ename->vla-object (ssname lines 0)))
      (setq line2 (vlax-ename->vla-object (ssname lines 1)))
      (setq p1 (vlax-curve-getstartpoint line1))
      (setq p2 (vlax-curve-getendpoint line1))
      (setq p3 (vlax-curve-getstartpoint line2))
      (setq p4 (vlax-curve-getendpoint line2))
      
      ;; Calculate the intersection point
      (setq intpt (vlax-curve-getclosestpointto line1 (vlax-curve-getclosestpointto line2 p1)))
      
      ;; Calculate the distance between the intersection point and the start/end points of line1
      (setq dist1 (distance intpt p1))
      (setq dist2 (distance intpt p2))
      
      ;; Calculate the angle of line1
      (setq ang1 (angle p1 p2))
      
      ;; Calculate the new points outside of line1
      (setq newp1 (polar intpt (+ ang1 (/ pi 2.0)) (+ (abs dist1) 10.0)))
      (setq newp2 (polar intpt (+ ang1 (/ pi 2.0)) (+ (abs dist2) 10.0)))
      
      ;; Create a closed polygon
      (setq poly (vla-add (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-vla-object->variant (list p1 newp1 newp2 p2 p3 p4 p1))))
      (vla-update poly)
      (princ "\nOuter polygon created.")
    )
    (princ "\nPlease select exactly 2 lines.")
  )
  (princ)
)

Kent1Cooper · ‎04-18-2024

"It doesn't work" is never enough information.

Your "lines" are Polylines, but your code restricts selection to Lines. If I Explode them to Lines and use your original code, I get:

; error: no function definition: VLAX-VLA-OBJECT->VARIANT

I'll let you work that out, but I don't understand what all the calculations are for [but haven't studied them closely], and it seems to me this can be quite a bit simpler:

(defun c:OuterPolygon (/ lines line1 line2 p1 p2 p3 p4)
  (setq lines (ssget '((0 . "LINE"))))
  (if (= (sslength lines) 2)
    (progn
      (setq line1 (ssname lines 0))
      (setq line2 (ssname lines 1))
      (setq p1 (vlax-curve-getstartpoint line1))
      (setq p2 (vlax-curve-getendpoint line1))
      (setq p3 (vlax-curve-getstartpoint line2))
      (setq p4 (vlax-curve-getendpoint line2))
      (command "_.pline" "_non" p1 "_non" p3 "_non" p2 "_non" p4 "_close")
    )
    (princ "\nPlease select exactly 2 lines.")
  )
  (princ)
)

[Note that there is no need for VLA-object conversion -- the (vlax-curve,,,) functions can work with just the entity name.]

EDIT: Also, would they ever be two Lines / Polylines that do not cross? If so, this could make a butterfly/hourglass shape, or others depending on the geometric relationship. Should there be a test for whether they intersect?

Kent Cooper, AIA

CADaSchtroumpf · ‎04-18-2024

To complete Kent with polylines

(defun c:OuterPolygon ( / lines line1 line2 p1 p2 p3 p4)
  (while
    (not
      (setq
        lines (ssget '((-4 . "<OR") (0 . "LINE") (-4 . "<AND") (0 . "LWPOLYLINE") (90 . 2) (-4 . "AND>") (-4 . "OR>")))
      )
    )
  )
  (cond
    ((eq (sslength lines) 2)
      (setq
        line1 (ssname lines 0)
        line2 (ssname lines 1)
        p1 (vlax-curve-getstartpoint line1)
        p2 (vlax-curve-getendpoint line1)
        p3 (vlax-curve-getstartpoint line2)
        p4 (vlax-curve-getendpoint line2)
      )
      (entmake
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(62 . 4)
          '(100 . "AcDbPolyline")
          '(90 . 4)
          '(70 . 1)
          (cons 10 p1)
          (cons 10 p3)
          (cons 10 p2)
          (cons 10 p4)
        )
      )
    )
    (T
      (princ "\nPlease select exactly 2 lines.")
    )
  )
  (prin1)
)

Kent1Cooper · ‎04-18-2024

@Kent1Cooper wrote:

..... Should there be a test for whether they intersect?

To take it to extremes, this does that, as well as accepting only single-line-segment open Polylines [just filtering for 2 vertices would accept, for example, a DONUT of two arc segments, closed, in which case, in addition to being meaningless for the purpose, the start and end points would be the same].

(defun c:OuterPolygon (/ lines line1 line2 p1 p2 p3 p4)
  (prompt "\nTo draw the polygon around 2 crossing Lines or single-line-segment open Polylines,")
  (setq lines
    (ssget
      '(
        (-4 . "<OR")
          (0 . "LINE")
          (-4 . "<AND")
            (0 . "LWPOLYLINE")
            (90 . 2); two vertices only
            (42 . 0.0); line segment only
            (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>"); not closed [single segment]
          (-4 . "AND>")
        (-4 . "OR>")
      ); filter list
    ); ssget
  ); setq
  (if (= (sslength lines) 2)
    (progn; then
      (setq
        line1 (ssname lines 0)
        line2 (ssname lines 1)
        p1 (vlax-curve-getstartpoint line1)
        p2 (vlax-curve-getendpoint line1)
        p3 (vlax-curve-getstartpoint line2)
        p4 (vlax-curve-getendpoint line2)
      ); setq
      (if (inters p1 p2 p3 p4 T); they cross
        (command "_.pline" "_non" p1 "_non" p3 "_non" p2 "_non" p4 "_close"); then
        (prompt "\nLines/Polylines must cross."); else
      ); if
    ); progn
    (prompt "\nMust select exactly 2 crossing Lines or single-line-segment open Polylines."); else
  ); if
  (prin1)
); defun

Kent Cooper, AIA

CADaSchtroumpf · ‎04-18-2024

@Kent1Cooper

Good thinking for the intersection test to make the code more reliable.
On the other hand, the line:
(-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>"); not closed [single segment]
seems unnecessary to me since you specified:
(90 . 2); two vertices only
(42 . 0.0); line segment only
therefore impossible for the end points to be identical/closed

And also, I prefere (if you not use entmake)

(command "_.pline" "_non" (trans p1 0 1) "_non" (trans p3 0 1) "_non" (trans p2 0 1) "_non" (trans p4 0 1) "_close")

komondormrex · ‎04-18-2024

check this out. any crossing or not lines or plines or other curves that comply to (vlax-curve-getstart[end]point) function . selection as per entity.

;*******************************************************************************************************************************************************

;	komondormrex, apr 2024

;*******************************************************************************************************************************************************

(defun vectors_angle (vector_1 vector_2 / x1 y1 z1 x2 y2 z2 ccw cos_a sin_a alpha)
  	(mapcar 'set '(x1 y1 z1) (mapcar '- (cadr vector_1) (car vector_1)))
  	(mapcar 'set '(x2 y2 z2) (mapcar '- (cadr vector_2) (car vector_2)))
	(setq cos_a (/ (+ (* x1 x2) (* y1 y2) (* z1 z2))
				   (* (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x1 y1 z1))))
					  (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x2 y2 z2))))
				   )
				)
		  sin_a (sqrt (- 1 (expt cos_a 2)))
	)
	(cond
		((zerop cos_a) (* 0.5 pi))
		((zerop (setq alpha (atan (/ sin_a cos_a)))) pi)
		((minusp alpha) (+ pi alpha))
		(t alpha)
	)
)

;*******************************************************************************************************************************************************

(defun c:2_curves_quadrilateral (/ curve_1 curve_2 point_1 point_2 point_3 point_4 v_1_2 v_1_3 v_1_4 compared_indices point_list)
	(setq curve_1 (car (entsel "\nPick 1st curve: "))
		  curve_2 (car (entsel "\nPick 2nd curve: "))
		  point_1 (vlax-curve-getstartpoint curve_1)
		  point_2 (vlax-curve-getendpoint curve_1)
		  point_3 (vlax-curve-getstartpoint curve_2)
		  point_4 (vlax-curve-getendpoint curve_2)
		  v_1_2 (list point_1 point_2)
		  v_1_3 (list point_1 point_3)
		  v_1_4 (list point_1 point_4)
  	)
	(cond
		((= 2 (setq compared_indices (car (vl-sort-i (list (vectors_angle v_1_2 v_1_3) (vectors_angle v_1_2 v_1_4) (vectors_angle v_1_3 v_1_4)) '>))))
			(setq point_list (list point_1 point_3 point_2  point_4))
		)
		((= 1 compared_indices) (setq point_list (list point_1 point_2 point_3 point_4)))
		(t (setq point_list (list point_1 point_3 point_4 point_2)))
	)
	(vla-put-closed (vla-addlightweightpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
												(vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 7)) 
																	 (apply 'append (mapcar '(lambda (vertex) (mapcar '+ '(0 0) vertex)) point_list)) 
						       				  	)
					)
				  	:vlax-true
	)
	(princ)
)

;*******************************************************************************************************************************************************

7598165 · ‎04-18-2024

It's more general. Calculate the convex hull of all points and connect them to draw them.

7598165 · ‎04-18-2024

Kent1Cooper · ‎04-18-2024

@CADaSchtroumpf wrote:

....

On the other hand, the line:
(-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>"); not closed [single segment]
seems unnecessary to me since you specified:
(90 . 2); two vertices only
(42 . 0.0); line segment only
therefore impossible for the end points to be identical/closed

....

Not true. You can draw a Polyline starting with a line segment between two points, and then Close it, so that it has only two vertices and only zero bulge factors, but two line segments overlapping each other, the second one backtracking over the first. Or a shape like this:

if the line segment is the first one. Either of those will be accepted in selection if all that is filtered for is 2 vertices and zero bulge factor [it looks at only the first bulge factor], but no filtering is done for whether they're closed. And in both cases the start and end are in the same place.

Kent Cooper, AIA

ancrayzy · ‎04-18-2024

Thank you for all your helps.

I tried each Lisp one by one, and clicked 'Accept solution' for the one that worked, so everyone can quickly find a solution.

ancrayzy · ‎04-18-2024

It works well, but only allows selecting 1 by 1 object, it would be better if allows drag to select multiple objects at the same time.

ancrayzy · ‎04-18-2024

It's great, it allows selecting multiple objects (i mean objects = pairs of lines/polylines....) at the same time. Can you share this lisp file?

CADaSchtroumpf · ‎04-19-2024

@ancrayzy a écrit :
it allows selecting multiple objects (i mean objects = pairs of lines/polylines....) at the same time.

@ancrayzy

Hi,
To make several couples at once, you can do this.
Kent is right, we must keep the condition that the polyline is not closed even for only two vertices.

(defun c:OuterPolygon ( / lines line1 line2 p1 p2 p3 p4 n flag)
  (prompt "\nTo draw the polygon around 2 crossing Lines or single-line-segment open Polylines,")
  (setq lines
    (ssget
      '(
        (-4 . "<OR")
          (0 . "LINE")
          (-4 . "<AND")
            (0 . "LWPOLYLINE")
            (90 . 2); two vertices only
            (42 . 0.0); line segment only
            (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>"); not closed [single segment]
          (-4 . "AND>")
        (-4 . "OR>")
      ); filter list
    ); ssget
  ); setq
  (while (> (/ (sslength lines) 2) 0)
    (setq
      line1 (ssname lines 0)
      p1 (vlax-curve-getstartpoint line1)
      p2 (vlax-curve-getendpoint line1)
    ); setq
    (ssdel line1 lines)
    (setq n (sslength lines) flag T)
    (while (and flag (not (zerop n)))
      (setq
        line2 (ssname lines (setq n (1- n)))
        p3 (vlax-curve-getstartpoint line2)
        p4 (vlax-curve-getendpoint line2)
      )
      (if (inters p1 p2 p3 p4 T); they cross
        (progn
          (entmake
            (list
              '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(62 . 4)
              '(100 . "AcDbPolyline")
              '(90 . 4)
              '(70 . 1)
              (cons 10 p1)
              (cons 10 p3)
              (cons 10 p2)
              (cons 10 p4)
            )
          )
          (ssdel line2 lines)
          (setq flag nil)
        ); progn
        (setq flag T)
      ); if
    ); while
  ); while
  (prin1)
)

komondormrex · ‎04-19-2024

check this out. any curves can be mass selected.

;*******************************************************************************************************************************************************

;	komondormrex, apr 2024

;*******************************************************************************************************************************************************

(defun vectors_angle (vector_1 vector_2 / x1 y1 z1 x2 y2 z2 ccw cos_a sin_a alpha)
  	(mapcar 'set '(x1 y1 z1) (mapcar '- (cadr vector_1) (car vector_1)))
  	(mapcar 'set '(x2 y2 z2) (mapcar '- (cadr vector_2) (car vector_2)))
	(setq cos_a (/ (+ (* x1 x2) (* y1 y2) (* z1 z2))
				   (* (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x1 y1 z1))))
					  (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x2 y2 z2))))
				   )
				)
		  sin_a (sqrt (- 1 (expt cos_a 2)))
	)
	(cond
		((zerop cos_a) (* 0.5 pi))
		((zerop (setq alpha (atan (/ sin_a cos_a)))) pi)
		((minusp alpha) (+ pi alpha))
		(t alpha)
	)
)

;*******************************************************************************************************************************************************

(defun c:2_curves_quadrilateral ( / curves_sset curves_list curve_1 curve_2 point_1 point_2 point_3 point_4 v_1_2 v_1_3 v_1_4 compared_indices point_list)
	(if (setq curves_sset (ssget))
		(if (setq curves_list (vl-remove-if '(lambda (curve) (or (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list curve))) 
																 (equal (vlax-curve-getstartpoint curve) 
																		(vlax-curve-getendpoint curve)
																 )
															 )
											 )
											 (vl-remove-if 'listp (mapcar 'cadr (ssnamex curves_sset)))
							   )
			)
			(if (zerop (rem (length curves_list) 2))
				(while (<= 2 (length curves_list))
					(setq curve_1 (car curves_list))
					(setq curves_list (cdr curves_list))
					(setq mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-curve-getstartpoint curve_1) (vlax-curve-getendpoint curve_1))))
					(setq curves_list (vl-sort curves_list '(lambda (curve_1 curve_2)
																	(< (distance mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-curve-getstartpoint curve_1)
																		   													  (vlax-curve-getendpoint curve_1)
																												   )
																						   	 )
																	   )
																	   (distance mid_point_1 (mapcar '* '(0.5 0.5) (mapcar '+ (vlax-curve-getstartpoint curve_2)
																	 		   			 									  (vlax-curve-getendpoint curve_2)
																	 					 						   )
																	 					 	 )
																	   )
																  	)
														 	)
								      )
						  curve_2 (car curves_list)
					  	  point_1 (vlax-curve-getstartpoint curve_1)
					  	  point_2 (vlax-curve-getendpoint curve_1)
					  	  point_3 (vlax-curve-getstartpoint curve_2)
					  	  point_4 (vlax-curve-getendpoint curve_2)
					  	  v_1_2 (list point_1 point_2)
					  	  v_1_3 (list point_1 point_3)
					  	  v_1_4 (list point_1 point_4)
						  curves_list (cdr curves_list)
  					)
					(cond
						((= 2 (setq compared_indices (car (vl-sort-i (list (vectors_angle v_1_2 v_1_3) (vectors_angle v_1_2 v_1_4) (vectors_angle v_1_3 v_1_4)) '>))))
							(setq point_list (list point_1 point_3 point_2 point_4))
						)
						((= 1 compared_indices) (setq point_list (list point_1 point_2 point_3 point_4)))
						(t (setq point_list (list point_1 point_3 point_4 point_2)))
					)
					(vla-put-closed (vla-addlightweightpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
																(vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 7))
																					 (apply 'append (mapcar '(lambda (vertex) (mapcar '+ '(0 0) vertex)) point_list))
										       				  	)
									)
								  	:vlax-true
					)
				)
				(alert "\n     Odd number of curves selected")
			)
			(alert "\n     No applicable curves selected")
		)
	)
	(princ)
)

;*******************************************************************************************************************************************************

ancrayzy · ‎04-19-2024

Thank you both @CADaSchtroumpf , @komondormrex for these 2 great versions.

These all codes work well, @komondormrex 's version can work well in the case of 2 parallel objects.

Create a closed polygon covering the 4 endpoints of any 2 lines or polylines

Create a closed polygon covering the 4 endpoints of any 2 lines or polylines

Forums Links

Post to forums