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

0 Members and 1 Guest are viewing this topic.

#### ronjonp ##### Re: Check polyline for square/rectangle
« Reply #15 on: January 09, 2013, 03:58:54 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.

REGULARPOLYGON-P tests the distance (within a fuzz value) from the centroid to all the vertexes. A parallelogram will fail its test. I'd think the angle test would not be needed either? But I've been wrong before...

« Last Edit: January 09, 2013, 04:04:38 PM by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC ##### Re: Check polyline for square/rectangle
« Reply #16 on: January 09, 2013, 04:03:58 PM »
What about checking for arc segments... #### ronjonp ##### Re: Check polyline for square/rectangle
« Reply #17 on: January 09, 2013, 04:05:59 PM »
What about checking for arc segments...  Caught again!

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### fixo

• Guest ##### Re: Check polyline for square/rectangle
« Reply #18 on: January 09, 2013, 04:17:44 PM »
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)       (setq legs (mapcar 'distance (append (cdr pts)(list (car pts)))(append (reverse (cdr (reverse pts)))(list (last pts)))))       (vl-every '(lambda(x y)(equal x y fuzz))legs(reverse legs) )  ))`Looks like it works now

#### ronjonp ##### Re: Check polyline for square/rectangle
« Reply #19 on: January 09, 2013, 04:22:04 PM »
Checks for arc segments now 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)))       ;; Check for arc segments       (vl-every '(lambda (x)     (if (= 42 (car x))       (zerop (cdr x))       t     )   ) e       )       ;; Check distance from centroid to points       (vl-every '(lambda (p) (grdraw ap p 1) (equal (distance ap p) d fuzz)) pts)  ))(regularpolygon-p (car (entsel)) 0.0001)`

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC ##### Re: Check polyline for square/rectangle
« Reply #20 on: January 09, 2013, 04:22:55 PM »
Hi,

For rectangles, checking if diagonals intersect at their middle plus their lengthes equality should do the trick:

Code - Auto/Visual Lisp: [Select]
1. (defun rectangularp (p1 p2 p3 p4 fuzz)
2.   (and
3.     (equal (distance p1 p3) (distance p2 p4) fuzz)
4.     (equal (midPoint p1 p3) (midPoint p2 p4) fuzz)
5.   )
6. )
7.
8. (defun midPoint (p1 p2)
9.       (lambda (x1 x2) (/ (+ x1 x2) 2.))
10.     )
11.     p1
12.     p2
13.   )
14. ))

For regular poygons, checking sides lengthes and diagonal lengthes (rather than angles) should do the trick too:
Code - Auto/Visual Lisp: [Select]
1. (defun regularpolygonp  (pts fuzz)
2.   (and
3.     (> (length pts) 2)
4.         (lambda (d) (equal d (distance (last pts) (car pts)) fuzz))
5.       )
6.       (mapcar 'distance pts (cdr pts))
7.     )
8.     (or
9.       (= (length pts) 3)
10.           (lambda (d) (equal d (distance (last pts) (cadr pts)) fuzz))
11.         )
12.         (mapcar 'distance pts (append (cddr pts) (list (car pts))))
13.       )
14.     )
15.   )
16. )

PS: Ron, the distances from centroid to vertices are equal in a rectangle which is not a regular polygon (except if it's a square).
« Last Edit: January 09, 2013, 04:56:10 PM by gile »
Speaking English as a French Frog ##### Re: Check polyline for square/rectangle
« Reply #21 on: January 09, 2013, 04:59:34 PM »
One more variation...

Code - Auto/Visual Lisp: [Select]
1. (defun rectangle-p ( e / a b c d )
2.     (and
3.         (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget e)))))
4.         (= 4 (cdr (assoc 90 e)))
5.         (= 1 (logand 1 (cdr (assoc 70 e))))
6.         (nobulge-p e)
7.         (mapcar 'set '(a b c d)
8.                 (mapcar '(lambda ( x ) (if (= 10 (car x)) (list (cdr x)))) e)
9.             )
10.         )
11.         (perp-p (mapcar '- a b) (mapcar '- a d))
12.         (perp-p (mapcar '- a b) (mapcar '- b c))
13.         (perp-p (mapcar '- a d) (mapcar '- c d))
14.     )
15. )
16.
17. (defun perp-p ( u v )
18.     (equal 0.0 (apply '+ (mapcar '* u v)) 1e-8)
19. )
20.
21. (defun nobulge-p ( e / p )
22.     (or (not (setq p (assoc 42 e)))
23.         (and (equal 0.0 (cdr p) 1e-8)
24.              (nobulge-p (cdr (member p e)))
25.         )
26.     )
27. )

#### ribarm ##### Re: Check polyline for square/rectangle
« Reply #22 on: January 10, 2013, 01:21:27 AM »
I guess, if I didn't make any mistake, this should be Lee's version for any rectangle in 3d space with some relative UCS...

Code - Auto/Visual Lisp: [Select]
1. (defun rectangle-p ( ent / a b c d e f g )
2.    (and
3.       (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget ent)))))
4.       (= 4 (cdr (assoc 90 e)))
5.       (= 1 (logand 1 (cdr (assoc 70 e))))
6.       (nobulge-p e)
7.       (setq f -1.0)
8.       (repeat 4
9.          (setq g (append g (setq g (list (setq f (1+ f))))))
10.       )
11.       (mapcar 'set '(a b c d)
12.              (mapcar '(lambda ( x ) (list (vlax-curve-getpointatparam ent x))) g)
13.          )
14.       )
15.       (perp-p (mapcar '- a b) (mapcar '- a d))
16.       (perp-p (mapcar '- a b) (mapcar '- b c))
17.       (perp-p (mapcar '- a d) (mapcar '- c d))
18.    )
19. )
20.
21. (defun perp-p ( u v )
22.    (equal 0.0 (apply '+ (mapcar '* u v)) 1e-8)
23. )
24.
25. (defun nobulge-p ( e / p )
26.    (or (not (setq p (assoc 42 e)))
27.        (and (equal 0.0 (cdr p) 1e-8)
28.           (nobulge-p (cdr (member p e)))
29.        )
30.    )
31. )
32.
« Last Edit: January 10, 2013, 02:14:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ribarm ##### Re: Check polyline for square/rectangle
« Reply #23 on: January 10, 2013, 03:01:04 AM »
My apology to Lee, both versions work in 3d in any UCS... It's just that Lee's version takes vectors from 2d points of rectangles OCS, and my version from 3d points expressed in WCS...

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #24 on: January 10, 2013, 03:04:51 AM »
my first version:
Code - Auto/Visual Lisp: [Select]
1. (defun test (e f / a b)
2.               (mapcar (function -)
3.                       (setq a (vlax-curve-getFirstDeriv e 2))
4.                       (setq b (vlax-curve-getFirstDeriv e 3))
5.               )
6.               f
7.        )
8.        (equal ((lambda (a) (abs (/ (sin a) (cos a)))) (/ (- (angle '(0 0) a) (angle '(0 0) b)) 2.))
9.               1
10.               f
11.        )
12.   )
13. )
Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #25 on: January 10, 2013, 03:11:33 AM »
my second version:
Code - Auto/Visual Lisp: [Select]
1. (defun test2 (e f / a b)
2.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
3.               f
4.        )
5.        (equal ((lambda (a) (abs (/ (sin a) (cos a))))
6.                 (/ (- (angle '(0 0) (vlax-curve-getFirstDeriv e 2))
7.                       (angle '(0 0) (vlax-curve-getFirstDeriv e 3))
8.                    )
9.                    2.
10.                 )
11.               )
12.               1
13.               f
14.        )
15.   )
16. )
Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #26 on: January 10, 2013, 03:19:00 AM »
my next version...
Code - Auto/Visual Lisp: [Select]
1. (defun test3 (e f / a)
2.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
3.               f
4.        )
5.        (not
6.          (inters '(0 0)
7.                  '(0 0)
8.                  ((lambda (a) (list (- (cadr a)) (car a) (caddr a))) (vlax-curve-getFirstDeriv e 1))
9.          )
10.        )
11.   )
12. )
Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #27 on: January 10, 2013, 03:31:42 AM »
Oops, it seems my version does not always work right ... Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #28 on: January 10, 2013, 03:45:19 AM »
new version:
Code - Auto/Visual Lisp: [Select]
1.             f
2.      )
3.             f
4.      )
5.      (equal ((lambda (a) (abs (/ (sin a) (cos a)))) (/ (- (angle '(0 0) a) (angle '(0 0) b)) 2.))
6.             1
7.             f
8.      )
9. )
Stay home. Stay safe. Save lives.

#### ElpanovEvgeniy ##### Re: Check polyline for square/rectangle
« Reply #29 on: January 10, 2013, 04:29:21 AM »
new version:
Code - Auto/Visual Lisp: [Select]
1. (defun test4 (e f / p1 p2 p3 p4)
2.   )
3.        (equal (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4)
4.               (mapcar (function (lambda (a b) (/ (+ a b) 2))) p1 p3)
5.               f
6.        )
7.   )
8. )
« Last Edit: January 10, 2013, 04:40:10 AM by ElpanovEvgeniy »
Stay home. Stay safe. Save lives.