TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Jeroen on January 08, 2013, 02:31:16 PM

Title: Check polyline for square/rectangle
Post by: Jeroen 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?
Title: Re: Check polyline for square/rectangle
Post by: ronjonp 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)))
Title: Re: Check polyline for square/rectangle
Post by: Tharwat on January 08, 2013, 02:55:33 PM
This should return T if the LWpolyline is a rectangle with equal angles and legs  :-D

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. )
Title: Re: Check polyline for square/rectangle
Post by: CAB on January 08, 2013, 04:24:37 PM
Something to play with.  8-)
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.     )
Title: Re: Check polyline for square/rectangle
Post by: CAB 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
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 08, 2013, 05:59:08 PM
Quote from: CAB 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

Thanks Alan, was just digging around for that function  8-)
Title: Re: Check polyline for square/rectangle
Post by: Jeremy on January 08, 2013, 09:06:32 PM
And don't forget this  :-D

http://www.theswamp.org/index.php?topic=41181.0 (http://www.theswamp.org/index.php?topic=41181.0)
Title: Re: Check polyline for square/rectangle
Post by: ronjonp 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)
Title: Re: Check polyline for square/rectangle
Post by: CAB on January 09, 2013, 09:28:10 AM
Nice one Ron.  8-)
Title: Re: Check polyline for square/rectangle
Post by: ronjonp on January 09, 2013, 09:34:50 AM
Quote from: CAB on January 09, 2013, 09:28:10 AM
Nice one Ron.  8-)

 :-D Thanks Charles!
Title: Re: Check polyline for square/rectangle
Post by: Jeroen on January 09, 2013, 10:41:11 AM
Thanks to all. This helps a lot.
Title: Re: Check polyline for square/rectangle
Post by: David Bethel 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
Title: Re: Check polyline for square/rectangle
Post by: CAB 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)
  )
)
Title: Re: Check polyline for square/rectangle
Post by: Jeremy 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.
Title: Re: Check polyline for square/rectangle
Post by: Stefan on January 09, 2013, 03:38:49 PM
Quote from: David Bethel 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
Quote from: CAB 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)
  )
)

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))
)
Title: Re: Check polyline for square/rectangle
Post by: ronjonp on January 09, 2013, 03:58:54 PM
Quote from: Jeremy 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.

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

Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 09, 2013, 04:03:58 PM
What about checking for arc segments...  :wink:
Title: Re: Check polyline for square/rectangle
Post by: ronjonp on January 09, 2013, 04:05:59 PM
Quote from: Lee Mac on January 09, 2013, 04:03:58 PM
What about checking for arc segments...  :wink:

 :police: Caught again!
Title: Re: Check polyline for square/rectangle
Post by: fixo on January 09, 2013, 04:17:44 PM
Small addition:
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
Title: Re: Check polyline for square/rectangle
Post by: ronjonp 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)
Title: Re: Check polyline for square/rectangle
Post by: gile 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.   (mapcar
  10.     (function
  11.       (lambda (x1 x2) (/ (+ x1 x2) 2.))
  12.     )
  13.     p1
  14.     p2
  15.   )
  16. ))

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.     (vl-every
  5.       (function
  6.         (lambda (d) (equal d (distance (last pts) (car pts)) fuzz))
  7.       )
  8.       (mapcar 'distance pts (cdr pts))
  9.     )
  10.     (or
  11.       (= (length pts) 3)
  12.       (vl-every
  13.         (function
  14.           (lambda (d) (equal d (distance (last pts) (cadr pts)) fuzz))
  15.         )
  16.         (mapcar 'distance pts (append (cddr pts) (list (car pts))))
  17.       )
  18.     )
  19.   )
  20. )

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).
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac 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.             (apply 'append
  9.                 (mapcar '(lambda ( x ) (if (= 10 (car x)) (list (cdr x)))) e)
  10.             )
  11.         )
  12.         (perp-p (mapcar '- a b) (mapcar '- a d))
  13.         (perp-p (mapcar '- a b) (mapcar '- b c))
  14.         (perp-p (mapcar '- a d) (mapcar '- c d))
  15.     )
  16. )        
  17.  
  18. (defun perp-p ( u v )
  19.     (equal 0.0 (apply '+ (mapcar '* u v)) 1e-8)
  20. )
  21.  
  22. (defun nobulge-p ( e / p )
  23.     (or (not (setq p (assoc 42 e)))
  24.         (and (equal 0.0 (cdr p) 1e-8)
  25.              (nobulge-p (cdr (member p e)))
  26.         )
  27.     )
  28. )
Title: Re: Check polyline for square/rectangle
Post by: ribarm 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 )
  3.    (and
  4.       (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget ent)))))
  5.       (= 4 (cdr (assoc 90 e)))
  6.       (= 1 (logand 1 (cdr (assoc 70 e))))
  7.       (nobulge-p e)
  8.       (setq f -1.0)
  9.       (repeat 4
  10.          (setq g (append g (setq g (list (setq f (1+ f))))))
  11.       )
  12.       (mapcar 'set '(a b c d)
  13.          (apply 'append
  14.              (mapcar '(lambda ( x ) (list (vlax-curve-getpointatparam ent x))) g)
  15.          )
  16.       )
  17.       (perp-p (mapcar '- a b) (mapcar '- a d))
  18.       (perp-p (mapcar '- a b) (mapcar '- b c))
  19.       (perp-p (mapcar '- a d) (mapcar '- c d))
  20.    )
  21. )        
  22.  
  23. (defun perp-p ( u v )
  24.    (equal 0.0 (apply '+ (mapcar '* u v)) 1e-8)
  25. )
  26.  
  27. (defun nobulge-p ( e / p )
  28.    (or (not (setq p (assoc 42 e)))
  29.        (and (equal 0.0 (cdr p) 1e-8)
  30.           (nobulge-p (cdr (member p e)))
  31.        )
  32.    )
  33. )
  34.  
Title: Re: Check polyline for square/rectangle
Post by: ribarm 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.
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 03:04:51 AM
my first version:
Code - Auto/Visual Lisp: [Select]
  1. (defun test (e f / a b)
  4.               (mapcar (function -)
  5.                       (vlax-curve-getStartPoint e)
  6.                       (setq a (vlax-curve-getFirstDeriv e 2))
  7.                       (setq b (vlax-curve-getFirstDeriv e 3))
  8.               )
  9.               f
  10.        )
  11.        (equal ((lambda (a) (abs (/ (sin a) (cos a)))) (/ (- (angle '(0 0) a) (angle '(0 0) b)) 2.))
  12.               1
  13.               f
  14.        )
  15.   )
  16. )
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 03:11:33 AM
my second version:
Code - Auto/Visual Lisp: [Select]
  1. (defun test2 (e f / a b)
  3.        (equal (vlax-curve-getArea e)
  4.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
  5.               f
  6.        )
  7.        (equal ((lambda (a) (abs (/ (sin a) (cos a))))
  8.                 (/ (- (angle '(0 0) (vlax-curve-getFirstDeriv e 2))
  9.                       (angle '(0 0) (vlax-curve-getFirstDeriv e 3))
  10.                    )
  11.                    2.
  12.                 )
  13.               )
  14.               1
  15.               f
  16.        )
  17.   )
  18. )
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 03:19:00 AM
my next version...
Code - Auto/Visual Lisp: [Select]
  1. (defun test3 (e f / a)
  3.        (equal (vlax-curve-getArea e)
  4.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
  5.               f
  6.        )
  7.        (not
  8.          (inters '(0 0)
  9.                  (vlax-curve-getFirstDeriv e 0)
  10.                  '(0 0)
  11.                  ((lambda (a) (list (- (cadr a)) (car a) (caddr a))) (vlax-curve-getFirstDeriv e 1))
  12.          )
  13.        )
  14.   )
  15. )
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 03:31:42 AM
Oops, it seems my version does not always work right ...  :-(
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 03:45:19 AM
new version:
Code - Auto/Visual Lisp: [Select]
  2.             (mapcar (function -) (vlax-curve-getFirstDeriv e 2))
  3.             f
  4.      )
  6.             (mapcar (function -) (vlax-curve-getFirstDeriv e 3))
  7.             f
  8.      )
  9.      (equal ((lambda (a) (abs (/ (sin a) (cos a)))) (/ (- (angle '(0 0) a) (angle '(0 0) b)) 2.))
  10.             1
  11.             f
  12.      )
  13. )
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 04:29:21 AM
new version:
Code - Auto/Visual Lisp: [Select]
  1. (defun test4 (e f / p1 p2 p3 p4)
  3.         p2 (vlax-curve-getpointatparam e 1)
  4.         p3 (vlax-curve-getpointatparam e 2)
  5.         p4 (vlax-curve-getpointatparam e 3)
  6.   )
  8.        (equal (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4)
  9.               (mapcar (function (lambda (a b) (/ (+ a b) 2))) p1 p3)
  10.               f
  11.        )
  12.   )
  13. )
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 10, 2013, 05:36:09 AM
Yes, Evgeniy...

Code - Auto/Visual Lisp: [Select]
  1. (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4)
  2.  
is the same as
Code - Auto/Visual Lisp: [Select]
  1. (mapcar (function (lambda (a b) (/ (+ a b) 2))) p2 p4)
  2.  

It seems that you deliberately make things more obscured...
 :wink:
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 05:59:12 AM
Quote from: ribarm on January 10, 2013, 05:36:09 AM
Yes, Evgeniy...

Code - Auto/Visual Lisp: [Select]
  1. (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4)
  2.  
is the same as
Code - Auto/Visual Lisp: [Select]
  1. (mapcar (function (lambda (a b) (/ (+ a b) 2))) p2 p4)
  2.  

It seems that you deliberately make things more obscured...
 :wink:

 :-D

Code - Auto/Visual Lisp: [Select]
  1. (defun p (a c) (entmakex (list '(0 . "point") (cons 62 c) (cons 10 a))))
  2. (defun c:test (/ p1 p2 p3 p4)
  3.   (setq e  (car (entsel))
  4.         f  1e-6
  5.         p1 (vlax-curve-getpointatparam e 0)
  6.         p2 (vlax-curve-getpointatparam e 1)
  7.         p3 (vlax-curve-getpointatparam e 2)
  8.         p4 (vlax-curve-getpointatparam e 3)
  9.   )
  10.   (p (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4) 1)
  11.   (p (mapcar (function (lambda (a b) (/ (+ a b) 2))) p2 p4) 2)
  12. )
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 10, 2013, 06:46:15 AM
If you agree, we are testing rectangle-p, not deltoid-p, and for rectangle (+ p1 p3 p1 p3 p2 p4)/6 is the same as (+ p2 p4)/2... And if you check for other 2 points (+ p1 p3)/2, the test should return equality...
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 06:54:13 AM
Now understand ...
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 10, 2013, 07:01:52 AM
Yes, you're right... You're checking for exactly rectangle, not any kind of romboid... So your code is fine... My apology, now I understand...
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 07:15:05 AM
My code is endless as my thoughts...  :-)
Code - Auto/Visual Lisp: [Select]
  1. (defun test (e f / l)
  2.   (setq l (mapcar (function vlax-curve-getpointatparam) (list e e e e) '(0 1 2 3)))
  3.   (vl-every (function (lambda (a b c) (equal (abs (sin (- (angle a b) (angle b c)))) 1 f)))
  4.             (cons (last l) l)
  5.             l
  6.             (cdr l)
  7.   )
  8. )
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 10, 2013, 07:20:04 AM
Still, I think that your code I've tested on romboid gives T and should nil, so I modified just a little...

Code - Auto/Visual Lisp: [Select]
  1. (defun rectangle-p (e f / p1 p2 p3 p4)
  4.          p2 (vlax-curve-getpointatparam e 1)
  5.          p3 (vlax-curve-getpointatparam e 2)
  6.          p4 (vlax-curve-getpointatparam e 3)
  7.    )
  9.         (equal (mapcar (function (lambda (a b) (/ (+ a b) 2))) p2 p4)
  10.                (mapcar (function (lambda (a b) (/ (+ a b) 2))) p1 p3)
  11.                f
  12.         )
  13.         (equal (distance p1 p3) (distance p2 p4) f)
  14.    )
  15. )
  16.  
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 10, 2013, 07:27:16 AM
you gave a new idea with triangles...  :-)
Code - Auto/Visual Lisp: [Select]
  1. (defun test5 (e f / p1 p2 p3 p4)
  3.         p2 (vlax-curve-getpointatparam e 1)
  4.         p3 (vlax-curve-getpointatparam e 2)
  5.         p4 (vlax-curve-getpointatparam e 3)
  6.   )
  7.   (equal (distance p4 (mapcar (function (lambda (a b c) (/ (+ a b c) 3))) p1 p2 p3))
  8.          (distance p3 (mapcar (function (lambda (a b c) (/ (+ a b c) 3))) p1 p2 p4))
  9.          f
  10.   )
  11. )
Title: Re: Check polyline for square/rectangle
Post by: owenwengerd on January 10, 2013, 12:04:06 PM
Uh oh. Bad programmer, bad!

http://otb.manusoft.com/2013/01/quirkypolyline-exposing-foolish-programmers.htm
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 10, 2013, 02:20:49 PM
Works with QuirkyPolylines :

Code - Auto/Visual Lisp: [Select]
  1. (defun rectangle-p (e f / dpar stp enp ptn k parpts index ptlst)
  3.    (setq dpar (/ (+ (abs (setq enp (vlax-curve-getendparam e))) (abs (setq stp (vlax-curve-getstartparam e)))) (setq ptn (cdr (assoc 90 (entget e))))))
  4.    (setq k -1.0)
  5.    (repeat ptn
  6.       (setq parpts (append parpts (setq parpts (list (+ stp (* (setq k (1+ k)) dpar))))))
  7.    )
  8.    (setq k -1)
  9.    (repeat ptn
  10.       (setq index (append index (setq index (list (setq k (1+ k))))))
  11.    )
  12.    (setq ptlst (mapcar '(lambda (x) (vlax-curve-getpointatparam e x)) parpts))
  13.    (and
  14.       (eq ptn 4)
  15.       (nobulge-p (if (eq (type e) 'ENAME) (vlax-ename->vla-object e) e) index f)
  16.       (equal (distance (nth 0 ptlst) (nth 1 ptlst)) (distance (nth 2 ptlst) (nth 3 ptlst)) f)
  17.       (equal (distance (nth 1 ptlst) (nth 2 ptlst)) (distance (nth 3 ptlst) (nth 0 ptlst)) f)
  18.       (equal (distance (nth 0 ptlst) (nth 2 ptlst)) (distance (nth 1 ptlst) (nth 3 ptlst)) f)
  19.    )
  20. )
  21.  
  22. (defun nobulge-p (e i f)
  23.    (apply 'and (mapcar '(lambda (x) (equal (vla-getbulge e x) 0.0 f)) i))
  24. )
  25.  
Title: Re: Check polyline for square/rectangle
Post by: owenwengerd on January 10, 2013, 02:33:02 PM
Much better! There is still room for improvement. ;)
[Hint: vlax-curve-GetDistAtPoint requires no use of parameters at all.]
Title: Re: Check polyline for square/rectangle
Post by: fixo on January 10, 2013, 05:08:38 PM
I've added check on bulged segments
Code: [Select]
(defun fxRectangle-p (en fuzz / leg obj pts)
 
(defun _getpt(obj idx)
  (vlax-safearray->list(vlax-variant-value (vla-get-coordinate obj  idx))))

(and
  (setq obj (vlax-ename->vla-object en))
  (eq "AcDbPolyline" (vla-get-objectname obj))
  (vlax-method-applicable-p obj 'getbulge)
  (vlax-property-available-p obj 'coordinate)
  (eq (vla-get-closed obj) :vlax-true)
  (= 8 (length (setq pts (vlax-get obj 'coordinates))))
  (vl-every '(lambda (x) (zerop (vla-getbulge obj x)))
    (list 0 1 2 3))
  (setq leg (- (vlax-curve-getdistatpoint
obj
(list (nth 2 pts) (nth 3 pts)))
       (vlax-curve-getdistatpoint obj (list (car pts) (cadr pts)))))
  (vl-every '(lambda (a b)
       (equal (abs (- (vlax-curve-getdistatpoint obj (_getpt obj a))
      (vlax-curve-getdistatpoint obj (_getpt obj b))))
      leg
      fuzz))
    (list 0 1 2)
    (list 1 2 3))
  (equal (/ pi 2) (abs (- (angle (_getpt obj 1)(_getpt obj 2))(angle (_getpt obj 2)(_getpt obj 3))))fuzz)
       )
)
Looks like it's what I need to use further
Title: Re: Check polyline for square/rectangle
Post by: owenwengerd on January 10, 2013, 09:30:52 PM
I like it, fixo. To make it more flexible, you could replace (eq "AcDbPolyline" (vla-get-objectname obj)) with something like this:

Code - Lisp: [Select]
  1. (vlax-property-available-p obj 'coordinates)
  2. (vlax-method-available-p obj 'getbulge)

Alternatively, you could use (vl-catch-all-apply) to gracefully handle invalid object types without testing at all. The goal would be to allow the code to work for any object type like a polyline, even if it is not actually an AcDbPolyline (or if it is a class derived from AcDbPolyline).
Title: Re: Check polyline for square/rectangle
Post by: fixo on January 10, 2013, 11:14:30 PM
Thanks, Owen
You're right
Kind regards,
Oleg
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 11, 2013, 01:36:54 AM
Here is complete code, based on Oleg's one... It doesn't use parameters, and it is applicable for any kind of 2d polyline old heavy, lightweight, quirky,... And no matter how it's oriented in 3d space with any UCS it works well...

Code - Auto/Visual Lisp: [Select]
  1. (defun unit ( v )
  2.   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  3. )
  4.  
  5. (defun mxv ( m v )
  6.   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  7. )
  8.  
  9. (defun v^v ( u v )
  10.   (list
  11.     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
  12.     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
  13.     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  14.   )
  15. )
  16.  
  17. (defun transptucs ( pt p1 p2 p3 / ux uy uz )
  18.   (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
  19.   (setq ux (unit (mapcar '- p2 p1)))
  20.   (setq uy (unit (mapcar '- p3 p1)))
  21.  
  22.   (mxv (list ux uy uz) (mapcar '- pt p1))
  23. )
  24.  
  25. (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
  26.   (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
  27.   (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
  28.   (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
  29.   (transptucs pt pt1n pt2n pt3n)
  30. )
  31.  
  32. (defun _getpt (obj idx)
  33.   (if (and (vlax-property-available-p obj 'coordinates)
  34.            (vlax-method-applicable-p obj 'getbulge)
  35.       )
  36.     (vlax-safearray->list
  37.       (vlax-variant-value (vla-get-coordinate obj idx))
  38.     )
  39.   )
  40. )
  41.  
  42. (defun perp-p ( u v fuzz )
  43.    (equal 0.0 (apply '+ (mapcar '* u v)) fuzz)
  44. )
  45.  
  46. (defun MR:Rectangle-p (en fuzz / obj pt pts k pts1 pts2 plel plptl uz ux uy ptlst leg)
  47.   (and
  48.     (setq obj (vlax-ename->vla-object en))
  49.     (eq (vla-get-closed obj) :vlax-true)
  50.     (or (= 8 (length (setq pts (vlax-get obj 'coordinates)))) (= 12 (length pts)))
  51.     (vl-every '(lambda (x) (zerop (vla-getbulge obj x)))
  52.               (list 0 1 2 3)
  53.     )
  54.     (cond
  55.       ((and (= 8 (length pts)) (eq (vla-get-objectname obj) "AcDbPolyline"))
  56.       (progn
  57.         (setq k 0.0)
  58.         (setq pts1 (vl-remove nil (mapcar '(lambda (x) (if (equal (/ k 2.0) (float (fix (/ (setq k (1+ k)) 2.0))) fuzz) x)) pts)))
  59.         (setq k 1.0)
  60.         (setq pts2 (vl-remove nil (mapcar '(lambda (x) (if (equal (/ k 2.0) (float (fix (/ (setq k (1+ k)) 2.0))) fuzz) x)) pts)))
  61.         (setq plel (vla-get-elevation obj))
  62.         (setq plptl (mapcar '(lambda (x y) (list x y plel)) pts1 pts2))
  63.       ))
  64.       ((and (= 12 (length pts)) (eq (vla-get-objectname obj) "AcDb2dPolyline"))
  65.       (progn
  66.         (setq plel (vla-get-elevation obj))
  67.         (repeat 4
  68.           (setq pt (list (car pts) (cadr pts) plel))
  69.           (setq pts (cdddr pts))
  70.           (setq plptl (cons pt plptl))
  71.         )
  72.         (setq plptl (reverse plptl))
  73.       ))
  74.       (nil T)
  75.     )
  76.     (setq uz (vlax-safearray->list (vlax-variant-value (vla-get-normal obj))))
  77.     (if (equal uz '(0.0 0.0 1.0) 1e-8) (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  78.     (if (equal uz '(0.0 0.0 -1.0) 1e-8) (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
  79.     (if (not (or (equal uz '(0.0 0.0 1.0) 1e-8) (equal uz '(0.0 0.0 -1.0) 1e-8))) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
  80.     (if (not uy) (setq uy (unit (v^v uz ux))))
  81.     (setq ptlst (mapcar '(lambda (p) (transptwcs p '(0.0 0.0 0.0) ux uy)) plptl))
  82.     (setq leg
  83.            (abs
  84.              (- (vlax-curve-getdistatpoint
  85.                   obj
  86.                   (nth 1 ptlst)
  87.                 )
  88.                 (vlax-curve-getdistatpoint obj (nth 0 ptlst))
  89.              )
  90.            )
  91.     )
  92.     (vl-every
  93.       '(lambda (a b)
  94.          (equal (abs (- (vlax-curve-getdistatpoint obj (transptwcs (list (car (_getpt obj a)) (cadr (_getpt obj a)) plel) '(0.0 0.0 0.0) ux uy))
  95.                         (vlax-curve-getdistatpoint obj (transptwcs (list (car (_getpt obj b)) (cadr (_getpt obj b)) plel) '(0.0 0.0 0.0) ux uy))
  96.                      )
  97.                 )
  98.                 leg
  99.                 fuzz
  100.          )
  101.        )
  102.       (list 0 2)
  103.       (list 1 3)
  104.     )
  105.     (perp-p (mapcar '- (transptwcs (list (car (_getpt obj 2)) (cadr (_getpt obj 2)) plel) '(0.0 0.0 0.0) ux uy) (transptwcs (list (car (_getpt obj 1)) (cadr (_getpt obj 1)) plel) '(0.0 0.0 0.0) ux uy))
  106.             (mapcar '- (transptwcs (list (car (_getpt obj 3)) (cadr (_getpt obj 3)) plel) '(0.0 0.0 0.0) ux uy) (transptwcs (list (car (_getpt obj 2)) (cadr (_getpt obj 2)) plel) '(0.0 0.0 0.0) ux uy))
  107.             fuzz
  108.     )
  109.   )
  110. )
  111.  
  114.  

M.R.

BTW. On my comp. (vlax-method-available-p) function doesn't exist... I changed it to (vlax-method-applicable-p)
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 11, 2013, 02:05:43 AM
Quote from: owenwengerd on January 10, 2013, 12:04:06 PM
Uh oh. Bad programmer, bad!

http://otb.manusoft.com/2013/01/quirkypolyline-exposing-foolish-programmers.htm

Your polyline, easily returned to the default status.
If Autodesk will use only QuirkyPolyline, I will not be difficult to replace the library function vlax-curve* its eea-curve*...

Code - Auto/Visual Lisp: [Select]
  1. (defun eea-normalise-param-lwpoly (/ s)
  2.   (if (setq s (ssget "_x" '((0 . "lwpolyline"))))
  3.     (foreach a (ssnamex s) (entmakex (entget (cadr a))) (entdel (cadr a)))
  4.   )
  5.   (princ)
  6. )

ps. I would not assess the programmers of the parameter polylines!
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 11, 2013, 05:14:43 AM
Had mistake with old heavy pline - code now updated...

M.R.
Title: Re: Check polyline for square/rectangle
Post by: ribarm on January 11, 2013, 06:56:15 AM
I fixed it till now... There was case with it was failing... See picture...

M.R.
Title: Re: Check polyline for square/rectangle
Post by: LE3 on January 11, 2013, 09:52:51 AM
been a while of not doing lisp, so just trying to add something:
a simple routine to test on lwpolylines - no error control - guess that some progn's usage are not required, but.... have fun!
Code: [Select]
(vl-load-com)
(defun rtd (a /) (* (/ a pi) 180.0))
(defun C:TST (/ e shape coords sides isShape p1 p2 p3 p4)
(setq e (car (entsel)))
(setq shape (vlax-ename->vla-object e))
(setq coords (vlax-get shape 'coordinates))
(setq sides (/ (length coords) 2))
(setq isShape "Undefined")
(if (and (eq sides 4) (vl-every 'zerop (mapcar '(lambda (i) (vla-getBulge shape i)) (list 0 1 2 3))))
  (progn
    (setq p1 (list (nth 0 coords) (nth 1 coords)))
    (setq p2 (list (nth 2 coords) (nth 3 coords)))
    (setq p3 (list (nth 4 coords) (nth 5 coords)))
    (setq p4 (list (nth 6 coords) (nth 7 coords)))
    (if (and (and (eq (angle p1 p2) (angle p4 p3)) (eq (angle p1 p4) (angle p2 p3)))
     (or (equal (abs (rtd (- (angle p2 p3) (angle p1 p2)))) 90.0 0.001)
(equal (abs (rtd (- (angle p2 p3) (angle p1 p2)))) 270.0 0.001))) ;; is rectangle test
      (progn
(setq isShape "Rectangle")
(if (equal (distance p2 p3) (distance p1 p2) 0.001) ;; test for square
  (progn
    (setq isShape "Square")))))))
  (princ isShape) (princ))
Title: Re: Check polyline for square/rectangle
Post by: owenwengerd on January 11, 2013, 10:49:51 AM
Quote from: ElpanovEvgeniy on January 11, 2013, 02:05:43 AM
Your polyline, easily returned to the default status.

Very clever, however this will not work for custom classes derived from AcDbPolyline.
Title: Re: Check polyline for square/rectangle
Post by: David Bethel on January 12, 2013, 05:00:51 PM
I'd rethink it with a simple test:


Are the mid points of the diagonals equal

Code: [Select]
;;;TEST FOR 4 POINTS CREATING A RECTANGLE ( or Square )
;;;ARG -> 4 POINTS in EITHER CW or CCW ORDER & Fuzz
;;;RET -> T nil
(defun is_pt_lst_rect (p1 p2 p3 p4 fuzz)
  (equal (mapcar '(lambda (a b) (* (+ a b) 0.5)) p1 p3)
         (mapcar '(lambda (a b) (* (+ a b) 0.5)) p2 p4)
         fuzz))


Filtering out bulges, entity type etc would be up to the user but this should work regardless of UCS

-David

Title: Re: Check polyline for square/rectangle
Post by: owenwengerd on January 12, 2013, 06:13:46 PM
Quote from: David Bethel on January 12, 2013, 05:00:51 PM
Are the mid points of the diagonals equal

You also have to test whether the diagonals are the same length, otherwise a parallelogram creates a false positive.
Title: Re: Check polyline for square/rectangle
Post by: CAB on January 12, 2013, 06:38:28 PM
Not quite David.
Code: [Select]
(entmakex
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(62 . 7)
(100 . "AcDbPolyline")
(90 . 4)
(70 . 1)
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 56.8437 167.707)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 68.8437 -1.2646e-014)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 0.0 0.0)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(10 12.0 167.707)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(210 0.0 0.0 1.0)))
Title: Re: Check polyline for square/rectangle
Post by: CAB on January 12, 2013, 08:37:34 PM
More code.  8-)
Code - Auto/Visual Lisp: [Select]
  1. (defun rectangle-p      (ename fuzz / el pts bul)
  2.   (and (eq (type ename) 'ename)
  3.        (eq (cdr (assoc 0 (setq el (entget ename)))) "LWPOLYLINE")
  4.        (mapcar (function (lambda (x) (cond ((= (car x) 10)(setq pts (cons (cdr x) pts)))
  5.                                            ((= (car x) 42)(setq bul (cons (cdr x) bul))))))
  6.                el)
  7.        (= (length pts) 4)
  8.        (vl-every 'zerop bul)
  9.        (equal (distance (car pts) (caddr pts)) (distance (cadr pts) (cadddr pts)) fuzz)
  10.        (equal (polar (car pts)(angle (car pts) (caddr pts)) (/ (distance (car pts) (caddr pts)) 2))
  11.               (polar (cadr pts)(angle (cadr pts) (cadddr pts)) (/ (distance (cadr pts) (cadddr pts)) 2))
  12.          fuzz)
  13.   )
  14. )
Title: Re: Check polyline for square/rectangle
Post by: David Bethel on January 13, 2013, 06:59:06 AM
OK  I'll buy that.  -David
Title: Re: Check polyline for square/rectangle
Post by: irneb on January 13, 2013, 10:17:59 AM
Back to the vlax-curve idea - but for regular polygons and rectangles:
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun RegularPolygon-p (obj fuzz / n i half V1s V1m V1e V2s V2m V2e stillTrue)
  4.   (if (and (vlax-curve-isClosed obj) (= (rem (setq n (vlax-curve-getEndParam obj)) 2) 0.0))
  5.     (progn (setq i (1+ n) half (/ (fix n) 2) stillTrue t)
  6.       (while (and stillTrue (> (setq i (1- i)) half))
  7.         ;; Get the opposing vectors' start mid & end points
  8.         (mapcar '(lambda (var par) (set var (vlax-curve-getPointAtParam obj par)))
  9.                 '(V1s V1m V1e V2s V2m V2e)
  10.                 (list (- i half 1) (- i half 0.5) (- i half) (- i 1) (- i 0.5) i))
  11.         (setq stillTrue (and (equal (angle V1s V1m) (angle V1m V1e) fuzz) ;Check 1st vector bulge
  12.                              (equal (angle V2s V2m) (angle V2m V2e) fuzz) ;Check 2nd vector bulge
  13.                              (equal (distance V1s V1e) (distance V2s V2e) fuzz) ;Check vectors equal length
  14.                              (equal (distance V1s V2e) (distance V2s V1e) fuzz)))) ;Check diagonals equal length
  15.       (if stillTrue (fix n))))) ;Return number of vectors or nil if not regular
Now: I'm unsure what to do since the function name clearly states it should be regular polygons, but a rectangle is strictly speaking not "regular". So should consecutive vectors' lengths also be checked? That's not actually what the OP asked for is it?
Title: Re: Check polyline for square/rectangle
Post by: pBe on January 13, 2013, 10:48:59 AM
I thought just by checking all corner angles are perpendicular would be enough to say "by george it is indeed a rectangle!!"   ;D 


I'll start digging thru them wonderful codes and try to figure out what i'm missing.  :)


dig...dig...dig...
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 14, 2013, 06:56:58 AM
Quote from: pBe on January 13, 2013, 10:48:59 AM
I thought just by checking all corner angles are perpendicular would be enough to say "by george it is indeed a rectangle!!"   ;D 

Indeed it is (http://www.theswamp.org/index.php?topic=43522.msg487813#msg487813)  :-)
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 14, 2013, 07:01:45 AM
Quote from: irneb on January 13, 2013, 10:17:59 AM
Back to the vlax-curve idea - but for regular polygons and rectangles

What about equilateral triangles / pentagons / heptagons / nonagons ...  :wink:
Title: Re: Check polyline for square/rectangle
Post by: irneb on January 14, 2013, 07:33:51 AM
Yes I noticed the mistake after I posted the code yesterday. Just didn't have the time to fix it yet. Maybe later tonight. I'm thinking: "Just use the normal definition of regular polygons". I.e. all sides equal and all inner angles equal. Of course there should be at least 3 vectors (a 2 vector closed polyline wouldeffectively pass that test, but is it a polygon?)

In any case the OP simply wanted to know if rectangular. I think somewhere I say "Regular Polygon" and went a bit wonky - by implementing something neither here nor there.
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 14, 2013, 07:40:29 AM
Quote from: Lee Mac on January 14, 2013, 07:01:45 AM
What about equilateral triangles / pentagons / heptagons / nonagons ...  :wink:

 :-)
Code - Auto/Visual Lisp: [Select]
  1. (defun test-polygon (E FUZZ / L)
  3.                   (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget e))
  4.           )
  5.   )
  7.               (lambda (a b c d)
  8.                 (and (equal (cos (- (angle b c) (angle a b))) (cos (- (angle c d) (angle b c))) fuzz)
  9.                      (equal (distance a b) (distance b c) fuzz)
  10.                 )
  11.               )
  12.             )
  13.             l
  14.             (append (cdr l) l)
  15.             (append (cddr l) l)
  16.             (append (cdddr l) l)
  17.   )
  18. )
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 14, 2013, 07:52:03 AM
Nice Evgeniy  :-)

To offer an alternative...

Code - Auto/Visual Lisp: [Select]
  1. (defun regularpolygon-p ( e / f l )
  2.     (defun f ( l )
  3.         (or (null (cdddr l))
  4.             (and
  5.                 (equal
  6.                     (vxv (mapcar '- (car   l) (cadr   l))
  7.                          (mapcar '- (cadr  l) (caddr  l))
  8.                     )
  9.                     (vxv (mapcar '- (cadr  l) (caddr  l))
  10.                          (mapcar '- (caddr l) (cadddr l))
  11.                     )
  12.                     1e-8
  13.                 )
  14.                 (f (cdr l))
  15.             )
  16.         )
  17.     )
  18.     (and
  19.         (cddr (setq l (apply 'append (mapcar '(lambda ( x ) (if (= 10 (car x)) (list (cdr x)))) (entget e)))))
  20.         (f (cons (last l) l))
  21.     )
  22. )
  23.  
  24. ;; Vector Dot Product  -  Lee Mac
  25. ;; Args: u,v - vectors in R^n
  26.  
  27. (defun vxv ( u v )
  28.     (apply '+ (mapcar '* u v))
  29. )
Title: Re: Check polyline for square/rectangle
Post by: GP on January 14, 2013, 10:21:49 AM
Alternative method (the most accurate)  :-)

Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 14, 2013, 10:58:18 AM
Quote from: GP on January 14, 2013, 10:21:49 AM
Alternative method (the most accurate)  :-)

 :-D
Title: Re: Check polyline for square/rectangle
Post by: Stefan on January 14, 2013, 11:05:01 AM

Quote from: Lee Mac on January 14, 2013, 07:52:03 AM
Nice Evgeniy  :-)

To offer an alternative...
I was thinking of something similar. Your routine works for any regular polygon, including star shape, but fails for rectangles and for any shape containing exclusively right angles, because dot_product is 0.0 for perpendicular vectors.
Title: Re: Check polyline for square/rectangle
Post by: Lee Mac on January 14, 2013, 11:52:50 AM
Quote from: Stefan on January 14, 2013, 11:05:01 AM
Quote from: Lee Mac on January 14, 2013, 07:52:03 AM
Nice Evgeniy  :-)

To offer an alternative...
I was thinking of something similar. Your routine works for any regular polygon, including star shape, but fails for rectangles and for any shape containing exclusively right angles, because dot_product is 0.0 for perpendicular vectors.

Good catch Stefan - and there I was thinking I had a shortcut for checking both angle & length...
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 15, 2013, 03:21:57 AM
Quote from: Stefan on January 14, 2013, 11:05:01 AM
I was thinking of something similar. Your routine works for any regular polygon, including star shape, but fails for rectangles and for any shape containing exclusively right angles, because dot_product is 0.0 for perpendicular vectors.

 :-)
square of is a regular polyhedron
rectangle, this is the wrong polyhedron
Title: Re: Check polyline for square/rectangle
Post by: irneb on January 15, 2013, 03:35:52 AM
Quote from: ElpanovEvgeniy on January 15, 2013, 03:21:57 AM
Quote from: Stefan on January 14, 2013, 11:05:01 AM
I was thinking of something similar. Your routine works for any regular polygon, including star shape, but fails for rectangles and for any shape containing exclusively right angles, because dot_product is 0.0 for perpendicular vectors.

 :)
square of is a regular polyhedron
rectangle, this is the wrong polyhedron
Exactly what I was referring to here
Quote from: irneb on January 13, 2013, 10:17:59 AM
Now: I'm unsure what to do since the function name clearly states it should be regular polygons, but a rectangle is strictly speaking not "regular". So should consecutive vectors' lengths also be checked? That's not actually what the OP asked for is it?
Title: Re: Check polyline for square/rectangle
Post by: ElpanovEvgeniy on January 15, 2013, 04:07:48 AM
If the program needs to find rectangles, what about the other polygon with equal angles, for example:
Title: Re: Check polyline for square/rectangle
Post by: Stefan on January 15, 2013, 05:13:23 AM
Quote from: ElpanovEvgeniy on January 15, 2013, 03:21:57 AM
Quote from: Stefan on January 14, 2013, 11:05:01 AM
I was thinking of something similar. Your routine works for any regular polygon, including star shape, but fails for rectangles and for any shape containing exclusively right angles, because dot_product is 0.0 for perpendicular vectors.

 :-)
square of is a regular polyhedron
rectangle, this is the wrong polyhedron
You are right, a rectangle is not a regular polyhedron.
That's why I said that Lee's function (http://www.theswamp.org/index.php?topic=43522.msg488096#msg488096) fails, because it should return nil for rectangles, but it returns True.