### Author Topic: Check polyline for square/rectangle  (Read 13018 times)

0 Members and 1 Guest are viewing this topic.

#### Jeroen

• Newt
• Posts: 21
• BricsCAD & AutoLisp
##### Check polyline for square/rectangle
« on: January 08, 2013, 02:31:16 PM »
Is there a way i Lisp to check if a polyline is square/rectangled? Or is the easiest way to check if the distances and angles are equal and parallel?
Jeroen

#### ronjonp

• Needs a day job
• Posts: 7148
##### Re: Check polyline for square/rectangle
« Reply #1 on: January 08, 2013, 02:51:33 PM »
There's probably a better way but INTERS comes to mind to check if the sides are parallel.

Code: [Select]
`(and (null (inters p1 p2 p3 p4 nil)) (null (inters p1 p4 p2 p3 nil)))`

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### Tharwat

• Swamp Rat
• Posts: 526
• Hypersensitive
##### Re: Check polyline for square/rectangle
« Reply #2 on: January 08, 2013, 02:55:33 PM »
This should return T if the LWpolyline is a rectangle with equal angles and legs

Code - Auto/Visual Lisp: [Select]
1. (defun Rectangle-p (ent / angs e pts d p1 p2 p3 p4)
2.   (setq angs (list 0. (* pi 0.5) pi (* pi 1.5)))
3.   (if (eq (cdr (assoc 0 (setq e (entget ent)))) "LWPOLYLINE")
4.     (foreach p e
5.       (if (eq (car p) 10)
6.         (setq pts (cons p pts))
7.       )
8.     )
9.   )
10.   (if (and
11.         (eq 4 (length pts))
12.         (member (angle (setq p1 (vlax-curve-getpointatparam ent 0))
13.                        (setq p2 (vlax-curve-getpointatparam ent 1))
14.                 )
15.                 angs
16.         )
17.         (setq d (distance p1 p2))
18.         (member (angle p2 (setq p3 (vlax-curve-getpointatparam ent 2)))
19.                 angs
20.         )
21.         (eq d (distance p2 p3))
22.         (member (angle p3 (setq p4 (vlax-curve-getpointatparam ent 3)))
23.                 angs
24.         )
25.         (eq d (distance p3 p4))
26.         (member (angle p4 p1) angs)
27.         (eq d (distance p4 p1))
28.       )
29.     t
30.     nil
31.   )
32. )

#### CAB

• Global Moderator
• Seagull
• Posts: 10388
##### Re: Check polyline for square/rectangle
« Reply #3 on: January 08, 2013, 04:24:37 PM »
Something to play with.
Code - Auto/Visual Lisp: [Select]
1.     (defun Rectangle-p (ent / ang e pts)
2.       (defun ang (p1 p2 / a)
3.         (if (equal (setq a (angle p1 p2)) (* 2 pi) 0.0001) 0.0 a)
4.       )
5.       (cond
6.         ((/= (cdr (assoc 0 (setq e (entget ent)))) "LWPOLYLINE") "Not a LWPolyline")
7.         ((/= (length (setq pts (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) e)))) 4)
8.          "Not 4 sided")
9.         ((or (not(equal (ang (car pts)(cadr pts))(ang (cadddr pts)(caddr pts)) 0.0001))
10.              (not(equal (ang (cadr pts)(caddr pts))(ang (car pts)(cadddr pts)) 0.0001)))
11.          "Not Square or Rectangle")
12.         ((not(equal (distance (car pts)(caddr pts))(distance (cadr pts)(cadddr pts)) 0.0001))
13.          "Object is a Parallelogram")
14.         ((equal (distance (car pts)(cadr pts))(distance (cadr pts)(caddr pts)) 0.0001)
15.          "Object is a Square")
16.         (T)
17.       )
18.     )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

#### CAB

• Global Moderator
• Seagull
• Posts: 10388
##### Re: Check polyline for square/rectangle
« Reply #4 on: January 08, 2013, 05:02:38 PM »
After a little checking I found one Lee had done.
http://www.theswamp.org/index.php?topic=40249.msg455137#msg455137
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

#### Lee Mac

• Seagull
• Posts: 12390
• London, England
##### Re: Check polyline for square/rectangle
« Reply #5 on: January 08, 2013, 05:59:08 PM »
After a little checking I found one Lee had done.
http://www.theswamp.org/index.php?topic=40249.msg455137#msg455137

Thanks Alan, was just digging around for that function

#### Jeremy

• Guest
##### Re: Check polyline for square/rectangle
« Reply #6 on: January 08, 2013, 09:06:32 PM »

#### ronjonp

• Needs a day job
• Posts: 7148
##### Re: Check polyline for square/rectangle
« Reply #7 on: January 09, 2013, 09:21:25 AM »
Maybe this too:

Code: [Select]
`(defun regularpolygon-p (ename fuzz / ap d e p pts)  (and (eq (type ename) 'ename)       (eq (cdr (assoc 0 (setq e (entget ename)))) "LWPOLYLINE")       (setq pts (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) e)))       (> (length pts) 2)       (setq ap (mapcar '(lambda (p) (/ p (length pts))) (apply 'mapcar (cons '+ pts))))       (setq d (distance ap (car pts)))       (vl-every '(lambda (p) (equal (distance ap p) d fuzz)) pts)  ))(regularpolygon-p (car (entsel)) 0.0001)`
« Last Edit: January 09, 2013, 09:35:22 AM by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### CAB

• Global Moderator
• Seagull
• Posts: 10388
##### Re: Check polyline for square/rectangle
« Reply #8 on: January 09, 2013, 09:28:10 AM »
Nice one Ron.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

#### ronjonp

• Needs a day job
• Posts: 7148
##### Re: Check polyline for square/rectangle
« Reply #9 on: January 09, 2013, 09:34:50 AM »
Nice one Ron.

Thanks Charles!

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### Jeroen

• Newt
• Posts: 21
• BricsCAD & AutoLisp
##### Re: Check polyline for square/rectangle
« Reply #10 on: January 09, 2013, 10:41:11 AM »
Thanks to all. This helps a lot.
Jeroen

#### David Bethel

• Swamp Rat
• Posts: 641
##### Re: Check polyline for square/rectangle
« Reply #11 on: January 09, 2013, 01:50:12 PM »
A simple test ;
Code: [Select]
`(equal (distance lower_left upper_right) (distance upper_left lower_right) fuzz)`
-David
R12 Dos - A2K

#### CAB

• Global Moderator
• Seagull
• Posts: 10388
##### Re: Check polyline for square/rectangle
« Reply #12 on: January 09, 2013, 02:33:53 PM »
Nice David.
I guess it could be boiled down to this:
Code: [Select]
`(defun RECTANGLE-p (ename fuzz / e pts)  (and (eq (type ename) 'ename)       (eq (cdr (assoc 0 (setq e (entget ename)))) "LWPOLYLINE")       (setq pts (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) e)))       (= (length pts) 4)       (equal (distance (car pts) (caddr pts)) (distance (cadr pts) (cadddr pts)) fuzz)  ))`
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

#### Jeremy

• Guest
##### Re: Check polyline for square/rectangle
« Reply #13 on: January 09, 2013, 03:35:53 PM »
If I'm understanding you guys tests correctly you are simply testing to see if the diagonals are equal. This is not sufficient. REGULARPOLYGON-P tests if all the sides are equal but doesn't test vertex angles or parallelism. A rectangle must have at least 2 right angles and opposite pairs of sides must be equal in length. There must also be two different side lengths to distinguish from a square.

#### Stefan

• Bull Frog
• Posts: 235
##### Re: Check polyline for square/rectangle
« Reply #14 on: January 09, 2013, 03:38:49 PM »
A simple test ;
Code: [Select]
`(equal (distance lower_left upper_right) (distance upper_left lower_right) fuzz)`
-David
Nice David.
I guess it could be boiled down to this:
Code: [Select]
`(defun RECTANGLE-p (ename fuzz / e pts)  (and (eq (type ename) 'ename)       (eq (cdr (assoc 0 (setq e (entget ename)))) "LWPOLYLINE")       (setq pts (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) e)))       (= (length pts) 4)       (equal (distance (car pts) (caddr pts)) (distance (cadr pts) (cadddr pts)) fuzz)  ))`

Nice try David and CAB... Please test on this:
Code: [Select]
`(entmakeX  '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1)    (10 0.0 0.0) (10 3.0 0.0) (10 2.0 1.0) (10 1.0 1.0)))`