Author Topic: Check polyline for square/rectangle  (Read 22659 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: 7526
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 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Tharwat

  • Swamp Rat
  • Posts: 707
  • 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  :-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. )

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Check polyline for square/rectangle
« Reply #3 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.     )
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: 10401
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: 12906
  • 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  8-)

Jeremy

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

ronjonp

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

Custom Build PC

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Check polyline for square/rectangle
« Reply #8 on: January 09, 2013, 09:28:10 AM »
Nice one Ron.  8-)
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: 7526
Re: Check polyline for square/rectangle
« Reply #9 on: January 09, 2013, 09:34:50 AM »
Nice one Ron.  8-)

 :-D Thanks Charles!

Windows 11 x64 - AutoCAD /C3D 2023

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: 656
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: 10401
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: 319
  • The most I miss IRL is the Undo button
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))
)