Topic: Input 4 CCW points to form a polygon

[David Bethel]

Greetings again.

I'm trying to force a user into selecting 4 unique points that :

• Create a 4 side polygon
• Are counterclockwise orientation
• No 3 points are colinear
• A minimum dsitance (rad) apart
• All interior angles are less than 180

I thought the term would be 'regular polygon' to describe this shape but it is not.

I modified Giles clockwise-p function and that seems to work. 
I will probably force a 2Dd solution for the (distance) test just in case.
I'm having trouble figuring out the interior angles.  The geometry on the left is acceptable, the geometry on the right is not
I thought that a correct test would be if the sum of all of the interior angles equaled 360 degree.  Not  :-o

The end result is are end panels similar to the breath guard image

Any suggestion would be greatly appreciated !  -David

Code - Auto/Visual Lisp: [Select]

1. (defun c:4ccw (/ ra p1 p2 p3 p4 tp v1 v2 l1 l2 l3 l4)
2.  
3.   (initget 6)
4.   (setq ra (getdist "\nCorner Radius <1.0>:   "))
5.   (or ra (setq ra 1))
6.  
7.   (initget 1)
8.   (setq p1 (getpoint "\nP1:   "))
9.  
10.   (while (not p2)
11.          (initget 1)
12.          (setq tp (getpoint p1 "\nCCW P2:   "))
13.          (cond ((< (distance p1 tp) (* ra 2))
14.                 (princ "\tP1 and P2 Are Too Close Together - minimum (* rad 2.0) - Try Again"))
15.                (T
16.                 (setq p2 tp))))
17.  
18.   (grdraw p1 p2 1 3)
19.  
20.   (while (not p3)
21.          (initget 1)
22.          (setq tp (getpoint p2 "\nCCW P3:   "))
23.          (cond ((< (distance p2 tp) (* ra 2))
24.                 (princ "\tP2 and P3 Are Too Close Together - minimum (* rad 2.0) - Try Again"))
25.                ((equal (angle p1 p2) (angle p2 tp) 1e-14)
26.                 (princ "\tP1 P2 and P3 Are Colinear - Try Again"))
27.                ((minusp (sin (- (angle p1 tp) (angle p1 p2))))
28.                 (princ "\tP2 and P3 Are NOT Counterclockwise - Try Again"))
29.                (T
30.                 (setq p3 tp))))
31.  
32.   (grdraw p2 p3 2 3)
33.  
34.   (while (not p4)
35.          (initget 1)
36.          (setq tp (getpoint p3 "\nCCW P4:   "))
37.          (grdraw p3 tp 3 3)
38.          (grdraw tp p1 4 3)
39.          (cond ((< (distance p3 tp) (* ra 2))
40.                 (princ "\tP3 and P4 Are Too Close Together - minimum (* rad 2.0) - Try Again"))
41.                ((< (distance tp p1) (* ra 2))
42.                 (princ "\tP4 and P1 Are Too Close Together - minimum (* rad 2.0) - Try Again"))
43.                ((equal (angle p2 p3) (angle p3 tp) 1e-14)
44.                 (princ "\tP2 P3 and P4 Are Colinear - Try Again"))
45.                ((equal (angle tp p1) (angle p1 p2) 1e-14)
46.                 (princ "\tP4 P1 and P2 Are Colinear - Try Again"))
47.                ((minusp (sin (- (angle p2 tp) (angle p2 p3))))
48.                 (princ "\tP3 and P4 Are NOT Counterclockwise - Try Again"))
49.                ((and (setq v1 (angle p1 tp)
50.                            v2 (angle p1 p2)
51.                            l1 (if (> v1 v2)
52.                                   (- v1 v2)
53.                                   (+ (- (* 2 pi) v2) v1)))
54.                      (setq v1 (angle p2 p1)
55.                            v2 (angle p2 p3)
56.                            l2 (if (> v1 v2)
57.                                   (- v1 v2)
58.                                   (+ (- (* 2 pi) v2) v1)))
59.                      (setq v1 (angle p3 p2)
60.                            v2 (angle p3 tp)
61.                            l3 (if (> v1 v2)
62.                                   (- v1 v2)
63.                                   (+ (- (* 2 pi) v2) v1)))
64.                      (setq v1 (angle tp p3)
65.                            v2 (angle tp p1)
66.                            l4 (if (> v1 v2)
67.                                   (- v1 v2)
68.                                   (+ (- (* 2 pi) v2) v1)))
69.                      (not (equal (* pi 2.0) (+ l1 l2 l3 l4) 1e-8)))
70.                 (princ "\nThe 4 Points Do Not Form A Regular Polygon - Try Again"))
71.                (T
72.                 (setq p4 tp))))
73.  
74.   (alert (strcat "\nIncluded Angle V1 : " (angtos l1)
75.                  "\nIncluded Angle V2 : " (angtos l2)
76.                  "\nIncluded Angle V3 : " (angtos l3)
77.                  "\nIncluded Angle V4 : " (angtos l4)
78.                  "\nTotal Angle : " (rtos (+ l1 l2 l3 l4) 2 4)))
79.  
80.   (grdraw p3 p4 3 3)
81.   (grdraw p4 p1 4 3)
82.   (prin1))
83.  

[Lee Mac]

Since you are essentially looking for a convex polygon, perhaps the following would be an alternative approach:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / lst )
2.     (if (setq lst (getconvexpointsgreaterthanradius 4 1.0))
3.         (if (LM:listclockwise-p lst)
4.             (reverse lst)
5.             lst
6.         )
7.     )
8. )
9.  
10. (defun getconvexpointsgreaterthanradius ( num rad / con len pnt rtn )
11.     (if (setq pnt (getpoint "\nSpecify first point: "))
12.         (progn
13.             (setq rtn (list pnt))
14.             (while
15.                 (and (< (setq len (length rtn)) num)
16.                      (setq pnt (getpoint (car rtn) "\nSpecify next point: "))
17.                 )
18.                 (cond
19.                     (   (vl-some '(lambda ( x ) (equal x pnt 1e-8)) rtn)
20.                         (princ "\nPoints must be distinct.")
21.                     )
22.                     (   (vl-some '(lambda ( x ) (< (distance x pnt) rad)) rtn)
23.                         (princ (strcat "\nPoint must be further than " (rtos rad) " from other points."))
24.                     )
25.                     (   (< len 2)
26.                         (setq rtn (cons pnt rtn))
27.                     )
28.                     (   (and (< len 3) (apply 'LM:collinear-p (cons pnt rtn)))
29.                         (princ "\nPoints cannot be collinear.")
30.                     )
31.                     (   (< len (length (setq con (LM:convexhull (cons pnt rtn)))))
32.                         (setq rtn con)
33.                     )
34.                     (   (princ "\nPoints must form a convex polygon."))
35.                 )
36.             )
37.             (if (= len num) rtn)
38.         )
39.     )
40. )
41.  
42. ;; Convex Hull  -  Lee Mac
43. ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
44.  
45. (defun LM:convexhull ( lst / ch p0 )
46.     (cond
47.         (   (< (length lst) 4) lst)
48.         (   (setq p0 (car lst))
49.             (foreach p1 (cdr lst)
50.                 (if (or (< (cadr p1) (cadr p0))
51.                         (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
52.                     )
53.                     (setq p0 p1)
54.                 )
55.             )
56.             (setq lst
57.                 (vl-sort lst
58.                     (function
59.                         (lambda ( a b / c d )
60.                             (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
61.                                 (< (distance p0 a) (distance p0 b))
62.                                 (< c d)
63.                             )
64.                         )
65.                     )
66.                 )
67.             )
68.             (setq ch (list (caddr lst) (cadr lst) (car lst)))
69.             (foreach pt (cdddr lst)
70.                 (setq ch (cons pt ch))
71.                 (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
72.                     (setq ch (cons pt (cddr ch)))
73.                 )
74.             )
75.             ch
76.         )
77.     )
78. )
79.  
80. ;; Clockwise-p  -  Lee Mac
81. ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
82.                  
83. (defun LM:clockwise-p ( p1 p2 p3 )
84.     (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
85.             (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
86.         )
87.         1e-8
88.     )
89. )
90.  
91. ;; Collinear-p  -  Lee Mac
92. ;; Returns T if p1,p2,p3 are collinear
93.  
94. (defun LM:collinear-p ( p1 p2 p3 )
95.     (
96.         (lambda ( a b c )
97.             (or
98.                 (equal (+ a b) c 1e-8)
99.                 (equal (+ b c) a 1e-8)
100.                 (equal (+ c a) b 1e-8)
101.             )
102.         )
103.         (distance p1 p2) (distance p2 p3) (distance p1 p3)
104.     )
105. )
106.  
107. ;; List Clockwise-p - Lee Mac
108. ;; Returns T if the point list is clockwise oriented
109.  
110. (defun LM:listclockwise-p ( lst )
111.     (minusp
112.         (apply '+
113.             (mapcar
114.                 (function
115.                     (lambda ( a b )
116.                         (- (* (car b) (cadr a)) (* (car a) (cadr b)))
117.                     )
118.                 )
119.                 lst (cons (last lst) lst)
120.             )
121.         )
122.     )
123. )

The above uses my Convex Hull function.

This would allow the user to pick the points in any order, whilst maintaining the condition that the result is a convex polygon.

Lee

[David Bethel]

Thanks Lee !

I'll have to dig into this 1.  I don't know if I roll my own vl-some function.  I've made vl-sort functions before with limited luck.

Regards !  -David

[Lee Mac]

You're most welcome David 

Here is a Vanilla version of vl-some:

Code - Auto/Visual Lisp: [Select]

1. (defun al-some ( prd lst )
2.     (if lst (cond (((eval prd) (car lst))) ((al-some prd (cdr lst)))))
3. )

Here is a Vanilla version of vl-sort:

Code - Auto/Visual Lisp: [Select]

1. (defun al-sort ( lst fun / foo )
2.     (defun foo ( fun piv lst / lft rgt )
3.         (foreach itm lst
4.             (if ((eval fun) itm piv)
5.                 (setq lft (cons itm lft))
6.                 (setq rgt (cons itm rgt))
7.             )
8.         )
9.         (append (al-sort lft fun ) (cons piv (al-sort rgt fun)))
10.     )
11.     (if lst (foo fun (car lst) (cdr lst)))
12. )

(EDIT: Corrected argument order in recursive call to al-sort function)

[David Bethel]

Very cool Lee !

I thought I could simply replace (function with (quote.  Apparently not

I'll keep digging

-David

[Lee Mac]

Thanks David 

When replacing the vl-sort expression with the above Vanilla al-sort function, you should be able to supply a quoted lambda function, e.g.:

Code - Auto/Visual Lisp: [Select]

1. (al-sort lst
2.    '(lambda ( a b / c d )
3.         (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
4.             (< (distance p0 a) (distance p0 b))
5.             (< c d)
6.         )
7.     )
8. )

The above is untested however.

Let me know if you need any further assistance!

[David Bethel]

Morning Lee,

Sorry I'm not have much luck with this 1.

Code - Auto/Visual Lisp: [Select]

1.             (setq lst
2.                 (al-sort lst
3. ;                    (quote
4.                         '(lambda ( a b / c d )
5.                             (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
6.                                 (< (distance p0 a) (distance p0 b))
7.                                 (< c d)
8.                             )
9.                         )
10. ;                   )
11.                 )
12.             )
13.  
14.  

Here's the error that I'm  getting

Code: [Select]


Specify first point:
Specify next point:
Specify next point:
Specify next point: error: bad function
(10.0 7.0 0.0)
((10.0 7.0 0.0) (25.0 7.0 0.0) (25.0 15.0 0.0))
(EVAL FUN)
((EVAL FUN) ITM PIV)
(IF ((EVAL FUN) ITM PIV) (SETQ LFT (CONS ITM LFT)) (SETQ RGT (CONS ITM RGT)))
(FOREACH ITM LST (IF ((EVAL FUN) ITM PIV) (SETQ LFT (CONS ITM LFT)) (SETQ RGT
(CONS ITM RGT))))
(FOO FUN (CAR LST) (CDR LST))
(IF LST (FOO FUN (CAR LST) (CDR LST)))
(AL-SORT FUN LFT)
(APPEND (AL-SORT FUN LFT) (CONS PIV (AL-SORT FUN RGT)))
(FOO FUN (CAR LST) (CDR LST))
(IF LST (FOO FUN (CAR LST) (CDR LST)))

....

-David

[Lee Mac]

My apologies David! - I had the arguments reversed in the recursive call to the al-sort function (I changed the order quickly before posting to match the order used by vl-sort).

Please try the following instead:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / lst )
2.     (if (setq lst (getconvexpointsgreaterthanradius 4 1.0))
3.         (if (LM:listclockwise-p lst)
4.             (reverse lst)
5.             lst
6.         )
7.     )
8. )
9.  
10. (defun getconvexpointsgreaterthanradius ( num rad / con len pnt rtn )
11.     (if (setq pnt (getpoint "\nSpecify first point: "))
12.         (progn
13.             (setq rtn (list pnt))
14.             (while
15.                 (and (< (setq len (length rtn)) num)
16.                      (setq pnt (getpoint (car rtn) "\nSpecify next point: "))
17.                 )
18.                 (cond
19.                     (   (al-some '(lambda ( x ) (equal x pnt 1e-8)) rtn)
20.                         (princ "\nPoints must be distinct.")
21.                     )
22.                     (   (al-some '(lambda ( x ) (< (distance x pnt) rad)) rtn)
23.                         (princ (strcat "\nPoint must be further than " (rtos rad) " from other points."))
24.                     )
25.                     (   (< len 2)
26.                         (setq rtn (cons pnt rtn))
27.                     )
28.                     (   (and (< len 3) (apply 'LM:collinear-p (cons pnt rtn)))
29.                         (princ "\nPoints cannot be collinear.")
30.                     )
31.                     (   (< len (length (setq con (LM:convexhull (cons pnt rtn)))))
32.                         (setq rtn con)
33.                     )
34.                     (   (princ "\nPoints must form a convex polygon."))
35.                 )
36.             )
37.             (if (= len num) rtn)
38.         )
39.     )
40. )
41.  
42. ;; Convex Hull  -  Lee Mac
43. ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
44.  
45. (defun LM:convexhull ( lst / ch p0 )
46.     (cond
47.         (   (< (length lst) 4) lst)
48.         (   (setq p0 (car lst))
49.             (foreach p1 (cdr lst)
50.                 (if (or (< (cadr p1) (cadr p0))
51.                         (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
52.                     )
53.                     (setq p0 p1)
54.                 )
55.             )
56.             (setq lst
57.                 (al-sort lst
58.                    '(lambda ( a b / c d )
59.                         (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
60.                             (< (distance p0 a) (distance p0 b))
61.                             (< c d)
62.                         )
63.                     )
64.                 )
65.             )
66.             (setq ch (list (caddr lst) (cadr lst) (car lst)))
67.             (foreach pt (cdddr lst)
68.                 (setq ch (cons pt ch))
69.                 (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
70.                     (setq ch (cons pt (cddr ch)))
71.                 )
72.             )
73.             ch
74.         )
75.     )
76. )
77.  
78. ;; al-some  -  Lee Mac
79. ;; A Vanilla AutoLISP version of vl-some
80.  
81. (defun al-some ( prd lst )
82.     (if lst (cond (((eval prd) (car lst))) ((al-some prd (cdr lst)))))
83. )
84.  
85. ;; al-sort  -  Lee Mac
86. ;; A Vanilla AutoLISP version of vl-sort
87.  
88. (defun al-sort ( lst fun / foo )
89.     (defun foo ( fun piv lst / lft rgt )
90.         (foreach itm lst
91.             (if ((eval fun) itm piv)
92.                 (setq lft (cons itm lft))
93.                 (setq rgt (cons itm rgt))
94.             )
95.         )
96.         (append (al-sort lft fun) (cons piv (al-sort rgt fun)))
97.     )
98.     (if lst (foo fun (car lst) (cdr lst)))
99. )
100.  
101. ;; Clockwise-p  -  Lee Mac
102. ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
103.  
104. (defun LM:clockwise-p ( p1 p2 p3 )
105.     (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
106.             (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
107.         )
108.         1e-8
109.     )
110. )
111.  
112. ;; Collinear-p  -  Lee Mac
113. ;; Returns T if p1,p2,p3 are collinear
114.  
115. (defun LM:collinear-p ( p1 p2 p3 )
116.     (
117.         (lambda ( a b c )
118.             (or
119.                 (equal (+ a b) c 1e-8)
120.                 (equal (+ b c) a 1e-8)
121.                 (equal (+ c a) b 1e-8)
122.             )
123.         )
124.         (distance p1 p2) (distance p2 p3) (distance p1 p3)
125.     )
126. )
127.  
128. ;; List Clockwise-p - Lee Mac
129. ;; Returns T if the point list is clockwise oriented
130.  
131. (defun LM:listclockwise-p ( lst )
132.     (minusp
133.         (apply '+
134.             (mapcar
135.                 (function
136.                     (lambda ( a b )
137.                         (- (* (car b) (cadr a)) (* (car a) (cadr b)))
138.                     )
139.                 )
140.                 lst (cons (last lst) lst)
141.             )
142.         )
143.     )
144. )

Sorry for the inconvenience! 

[David Bethel]

OK I see what you've done now : return the solution (point list) for a convex polygon from 4 points regardless of the order that the points were inputted.

I don't think that have ever tried anything like that. 

My normal thought pattern :

Rectangle type functions - Pick the opposing 2 corners
Outline or border function - Pick the border or edge points in a continuous order

Your's looks to work something like the 3Point option of the circle command, only 4 points for a quadrilateral ( I think that is the term )

Very interesting.  Thanks!  -David