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

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7526
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 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Check polyline for square/rectangle
« Reply #16 on: January 09, 2013, 04:03:58 PM »
What about checking for arc segments...  :wink:

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Check polyline for square/rectangle
« Reply #17 on: January 09, 2013, 04:05:59 PM »
What about checking for arc segments...  :wink:

 :police: Caught again!

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

fixo

  • Guest
Re: Check polyline for square/rectangle
« Reply #18 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

ronjonp

  • Needs a day job
  • Posts: 7526
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 11 x64 - AutoCAD /C3D 2023

Custom Build PC

gile

  • Gator
  • Posts: 2507
  • Marseille, France
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.   (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).
« Last Edit: January 09, 2013, 04:56:10 PM by gile »
Speaking English as a French Frog

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
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.             (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. )

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.          (apply 'append
  13.              (mapcar '(lambda ( x ) (list (vlax-curve-getpointatparam ent x))) g)
  14.          )
  15.       )
  16.       (perp-p (mapcar '- a b) (mapcar '- a d))
  17.       (perp-p (mapcar '- a b) (mapcar '- b c))
  18.       (perp-p (mapcar '- a d) (mapcar '- c d))
  19.    )
  20. )        
  21.  
  22. (defun perp-p ( u v )
  23.    (equal 0.0 (apply '+ (mapcar '* u v)) 1e-8)
  24. )
  25.  
  26. (defun nobulge-p ( e / p )
  27.    (or (not (setq p (assoc 42 e)))
  28.        (and (equal 0.0 (cdr p) 1e-8)
  29.           (nobulge-p (cdr (member p e)))
  30.        )
  31.    )
  32. )
  33.  
« Last Edit: January 10, 2013, 02:14:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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)

:)

M.R. on Youtube

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
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.                       (vlax-curve-getStartPoint e)
  4.                       (setq a (vlax-curve-getFirstDeriv e 2))
  5.                       (setq b (vlax-curve-getFirstDeriv e 3))
  6.               )
  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.   )
  14. )

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
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.        (equal (vlax-curve-getArea e)
  3.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
  4.               f
  5.        )
  6.        (equal ((lambda (a) (abs (/ (sin a) (cos a))))
  7.                 (/ (- (angle '(0 0) (vlax-curve-getFirstDeriv e 2))
  8.                       (angle '(0 0) (vlax-curve-getFirstDeriv e 3))
  9.                    )
  10.                    2.
  11.                 )
  12.               )
  13.               1
  14.               f
  15.        )
  16.   )
  17. )

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
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.        (equal (vlax-curve-getArea e)
  3.               (* (setq a (vlax-curve-getDistAtParam e 1)) (- (vlax-curve-getDistAtParam e 2) a))
  4.               f
  5.        )
  6.        (not
  7.          (inters '(0 0)
  8.                  (vlax-curve-getFirstDeriv e 0)
  9.                  '(0 0)
  10.                  ((lambda (a) (list (- (cadr a)) (car a) (caddr a))) (vlax-curve-getFirstDeriv e 1))
  11.          )
  12.        )
  13.   )
  14. )

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
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 ...  :-(

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Check polyline for square/rectangle
« Reply #28 on: January 10, 2013, 03:45:19 AM »
new version:
Code - Auto/Visual Lisp: [Select]
  1.             (mapcar (function -) (vlax-curve-getFirstDeriv e 2))
  2.             f
  3.      )
  4.             (mapcar (function -) (vlax-curve-getFirstDeriv e 3))
  5.             f
  6.      )
  7.      (equal ((lambda (a) (abs (/ (sin a) (cos a)))) (/ (- (angle '(0 0) a) (angle '(0 0) b)) 2.))
  8.             1
  9.             f
  10.      )
  11. )

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
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.         p2 (vlax-curve-getpointatparam e 1)
  3.         p3 (vlax-curve-getpointatparam e 2)
  4.         p4 (vlax-curve-getpointatparam e 3)
  5.   )
  6.        (equal (mapcar (function (lambda (a b c d) (/ (+ a d c a b c) 6))) p1 p2 p3 p4)
  7.               (mapcar (function (lambda (a b) (/ (+ a b) 2))) p1 p3)
  8.               f
  9.        )
  10.   )
  11. )
« Last Edit: January 10, 2013, 04:40:10 AM by ElpanovEvgeniy »