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

0 Members and 1 Guest are viewing this topic.

Jeroen

• Newt
• Posts: 21
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: 7073
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: 520
• 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: 10376
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")
11.          "Not Square or Rectangle")
13.          "Object is a Parallelogram")
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

CAB

• Global Moderator
• Seagull
• Posts: 10376
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

Lee Mac

• Seagull
• Posts: 12313
• 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: 7073
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: 10376
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

ronjonp

• Needs a day job
• Posts: 7073
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
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: 10376
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

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