- Forums Home
- >
- AutoCAD Community
- >
- AutoCAD Customization Forum
- >
- Visual LISP, AutoLISP and General Customization forum
- >
- Create a closed polygon covering the 4 endpoints of any 2 lines or polylines

Announcements

Due to scheduled maintenance, the Autodesk Community will be inaccessible from 10:00PM PDT on Oct 16th for approximately 1 hour. We appreciate your patience during this time.

Community

Visual LISP, AutoLISP and General Customization

Turn on suggestions

Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.

This page has been translated for your convenience with an automatic translation service. This is not an official translation and may contain errors and inaccurate translations. Autodesk does not warrant, either expressly or implied, the accuracy, reliability or completeness of the information translated by the machine translation service and will not be liable for damages or losses caused by the trust placed in the translation service.
Translate

14 REPLIES 14

SOLVED
Topic Options

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page

Message 1 of 15

04-18-2024
04:03 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
04:03 AM

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)
)
```

Solved! Go to Solution.

Solved by komondormrex. Go to Solution.

Solved by CADaSchtroumpf. Go to Solution.

Solved by komondormrex. Go to Solution.

Solved by Kent1Cooper. Go to Solution.

Solved by CADaSchtroumpf. Go to Solution.

14 REPLIES 14

Message 2 of 15

04-18-2024
04:49 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
04:49 AM

"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?

Message 3 of 15

04-18-2024
04:58 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
04:58 AM

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)
)
```

Message 4 of 15

04-18-2024
05:45 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
05:45 AM

@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
```

Message 5 of 15

04-18-2024
06:12 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
06:12 AM

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

Message 6 of 15

04-18-2024
07:42 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
07:42 AM

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)
)
;*******************************************************************************************************************************************************
```

Message 9 of 15

04-18-2024
11:07 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
11:07 AM

@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.

Message 10 of 15

04-18-2024
07:16 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
07:16 PM

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.

Message 11 of 15

04-18-2024
07:22 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
07:22 PM

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.

Message 12 of 15

04-18-2024
07:26 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-18-2024
07:26 PM

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?

Message 13 of 15

04-19-2024
04:40 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-19-2024
04:40 AM

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

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)
)
```

Message 14 of 15

04-19-2024
04:58 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-19-2024
04:58 AM

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)
)
;*******************************************************************************************************************************************************
```

Message 15 of 15

04-19-2024
05:45 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

04-19-2024
05:45 PM

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.

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page

Can't find what you're looking for? Ask the community or share your knowledge.