francesc Posted July 4, 2014 Share Posted July 4, 2014 as I can tell if a polyline is a rectangle with lisp thank you Quote Link to comment Share on other sites More sharing options...
7o7 Posted July 4, 2014 Share Posted July 4, 2014 Maybe this? (setq poly (entget (car (entsel))) vertex (vl-remove-if-not '(lambda(x) (= 10 (car x))) poly)) (and (= 4 (cdr (assoc 90 poly))) (equal (distance (nth 0 vertex) (nth 2 vertex)) (distance (nth 1 vertex) (nth 3 vertex)))) Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted July 4, 2014 Share Posted July 4, 2014 ;almost same (defun rectangp (e / l) (and(=(cdr(assoc 90 (entget e)))4) (setq l(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))) (apply '= (mapcar '(lambda (a b) (distance (nth a l )(nth b l )) )'(0 1)'(2 3)))) ) Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted July 4, 2014 Share Posted July 4, 2014 (rectangp (car (entsel))); T or nil (rectangp (entlast)); T or nil Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted July 5, 2014 Share Posted July 5, 2014 @7o7 and hanhphuc Its not that simple, guys. More on this subject here. Quote Link to comment Share on other sites More sharing options...
7o7 Posted July 5, 2014 Share Posted July 5, 2014 Ah so!! I forgot the trapezoid!! (apply '= (mapcar '(lambda (a b) (distance (nth a l )(nth b l )))'(0 1 0 2)'(2 3 1 3)))) can fix it! (hanhphuc's way of coding is better than mine :) ) Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted July 5, 2014 Share Posted July 5, 2014 Sorry 7o7, it's not that either. In fact, your code never returns true for 4 coplanar and distinct points. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 5, 2014 Share Posted July 5, 2014 Rotate the rectang ??? 1st check though is must be a "Pline" I would use the co-ords of the pline 2nd check if more less 4 not rectang Then compare pt1 pt2 - pt3 p4 then pt2 pt - pt3 pt4-pt1 use length and angle (get direction correct or angle is 180 wrong) Quote Link to comment Share on other sites More sharing options...
7o7 Posted July 6, 2014 Share Posted July 6, 2014 (edited) Maybe this correct? (defun c:test() (setq poly (entget (car (entsel))) vertex (vl-remove-if-not '(lambda(x) (= 10 (car x))) poly)) (and (member '(90 . 4) poly) (member '(70 . 1) poly) (equal (distance (nth 0 vertex) (nth 2 vertex)) (distance (nth 1 vertex) (nth 3 vertex))) (zerop (abs (rem (+ (angle (nth 0 vertex) (nth 1 vertex)) (angle (nth 1 vertex) (nth 2 vertex))) (* 0.5 pi))) )) ) Edited July 6, 2014 by 7o7 Quote Link to comment Share on other sites More sharing options...
ur_naz Posted July 6, 2014 Share Posted July 6, 2014 You should also check the bulges of poly (defun rectangle-p ( en / poly vertex bulges) (setq poly (entget en) vertex (vl-remove-if-not '(lambda(x) (= 10 (car x))) poly) bulges (vl-remove-if-not '(lambda(x) (= 42 (car x))) poly)) (and (= "LWPOLYLINE" (cdr (assoc 0 poly))) (member '(90 . 4) poly) (member '(70 . 1) poly) (equal (distance (nth 0 vertex) (nth 2 vertex)) (distance (nth 1 vertex) (nth 3 vertex))) (zerop (abs (rem (+ (angle (nth 0 vertex) (nth 1 vertex)) (angle (nth 1 vertex) (nth 2 vertex)) ) (* 0.5 pi) ) ) ) (vl-every 'zerop (mapcar 'cdr bulges)) ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 6, 2014 Share Posted July 6, 2014 Another: (defun rectangle-p ( ent / p1 p2 p3 p4 ) (and (setq enx (entget ent)) (= "LWPOLYLINE" (cdr (assoc 0 enx))) (= 4 (cdr (assoc 90 enx))) (= 1 (logand 1 (cdr (assoc 70 enx)))) (nobulge-p enx) (mapcar 'set '(p1 p2 p3 p4) (lwvertices enx)) (equal (distance p1 p2) (distance p3 p4) 1e- (equal (distance p2 p3) (distance p1 p4) 1e- (equal (distance p1 p3) (distance p2 p4) 1e- ) ) (defun nobulge-p ( enx / bul ) (or (not (setq bul (assoc 42 enx))) (and (equal 0.0 (cdr bul) 1e- (nobulge-p (cdr (member bul enx))) ) ) ) (defun lwvertices ( enx / vtx ) (if (setq vtx (assoc 10 enx)) (cons (cdr vtx) (lwvertices (cdr (member vtx enx)))) ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 6, 2014 Share Posted July 6, 2014 (member '(70 . 1) poly) Be careful with LWPolylines with PLINEGEN enabled. Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted July 7, 2014 Share Posted July 7, 2014 ya i agree with Stafan, thanx for the advice: we should consider any shape polyline with bulge also has 4 vertexs. Basically Area=Length x Width, then compare with entity's area also can eliminate bulge Quote Link to comment Share on other sites More sharing options...
francesc Posted July 7, 2014 Author Share Posted July 7, 2014 thank you very much to all. All functions which is the best to detect a rectangle. Quote Link to comment Share on other sites More sharing options...
ur_naz Posted July 8, 2014 Share Posted July 8, 2014 Corrected version with extracting true rectangle points (defun rectangle-p (en / poly vertex bulges) (setq poly (entget en) vertex (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) poly) ; ) bulges (vl-remove-if-not '(lambda (x) (= 42 (car x))) poly) ) (and (= "LWPOLYLINE" (cdr (assoc 0 poly))) (member '(90 . 4) poly) (member '(70 . 1) poly) (equal (distance (nth 0 vertex) (nth 2 vertex)) (distance (nth 1 vertex) (nth 3 vertex)) ) (zerop (abs (rem (+ (angle (nth 0 vertex) (nth 1 vertex)) (angle (nth 1 vertex) (nth 2 vertex)) ) (* 0.5 pi) ) ) ) (vl-every 'zerop (mapcar 'cdr bulges)) ) ) ps while polyline can run through points p1->p2->p4->p3, the angles must be checked. So Lee's code is incorrect too Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 8, 2014 Share Posted July 8, 2014 ps while polyline can run through points p1->p2->p4->p3, the angles must be checked. So Lee's code is incorrect too Good catch - another version: (defun rectangle-p ( e / a b c d ) (and (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget e))))) (= 4 (cdr (assoc 90 e))) (= 1 (logand 1 (cdr (assoc 70 e)))) (nobulge-p e) (mapcar 'set '(a b c d) (apply 'append (mapcar '(lambda ( x ) (if (= 10 (car x)) (list (cdr x)))) e) ) ) (perp-p (mapcar '- a b) (mapcar '- a d)) (perp-p (mapcar '- a b) (mapcar '- b c)) (perp-p (mapcar '- a d) (mapcar '- c d)) ) ) (defun perp-p ( u v ) (equal 0.0 (apply '+ (mapcar '* u v)) 1e- ) (defun nobulge-p ( e / p ) (or (not (setq p (assoc 42 e))) (and (equal 0.0 (cdr p) 1e- (nobulge-p (cdr (member p e))) ) ) ) Quote Link to comment Share on other sites More sharing options...
ur_naz Posted July 8, 2014 Share Posted July 8, 2014 This version also checks if polyline's points lie on the same location (defun rectangle-p (en / poly vertex bulges) ;; (rectangle-p (car (entsel))) (setq poly (entget en) vertex (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) poly) ) bulges (vl-remove-if-not '(lambda (x) (= 42 (car x))) poly) ) (and (= "LWPOLYLINE" (cdr (assoc 0 poly))) (member '(90 . 4) poly) (member '(70 . 1) poly) (equal (distance (nth 0 vertex) (nth 2 vertex)) (distance (nth 1 vertex) (nth 3 vertex)) ) (< 0.0 (distance (nth 0 vertex) (nth 2 vertex))) (zerop (abs (rem (+ (angle (nth 0 vertex) (nth 1 vertex)) (angle (nth 1 vertex) (nth 2 vertex)) ) (* 0.5 pi) ) ) ) (vl-every 'zerop (mapcar 'cdr bulges)) ) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.