Jump to content

rectangle


francesc

Recommended Posts

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

Link to comment
Share on other sites

;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))))
)

Link to comment
Share on other sites

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 :):) )

Link to comment
Share on other sites

Sorry 7o7, it's not that either.

In fact, your code never returns true for 4 coplanar and distinct points.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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 by 7o7
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 :)

Link to comment
Share on other sites

:? 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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

)

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...