(and (null (inters p1 p2 p3 p4 nil)) (null (inters p1 p4 p2 p3 nil)))
After a little checking I found one Lee had done.
http://www.theswamp.org/index.php?topic=40249.msg455137#msg455137
(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)
Nice one Ron. 8-)
(equal (distance lower_left upper_right) (distance upper_left lower_right) fuzz)
(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)
)
)
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)
)
)
(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))
)
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.
What about checking for arc segments... :wink:
(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
(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)
Yes, Evgeniy...Code - Auto/Visual Lisp: [Select]is the same asCode - Auto/Visual Lisp: [Select]
It seems that you deliberately make things more obscured...
:wink:
(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
Uh oh. Bad programmer, bad!
http://otb.manusoft.com/2013/01/quirkypolyline-exposing-foolish-programmers.htm
(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))
Your polyline, easily returned to the default status.
;;;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))
Are the mid points of the diagonals equal
(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)))
I thought just by checking all corner angles are perpendicular would be enough to say "by george it is indeed a rectangle!!" ;D
Back to the vlax-curve idea - but for regular polygons and rectangles
What about equilateral triangles / pentagons / heptagons / nonagons ... :wink:
Alternative method (the most accurate) :-)
Nice Evgeniy :-)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.
To offer an alternative...
Nice Evgeniy :-)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.
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.
Exactly what I was referring to hereI 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
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?
You are right, a rectangle is not a regular polyhedron.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