find multiple Rectangles center

[Anonymous]

Hi all,

Please help with these issues.

I need AutoLISP to select the Rectangle objects (more than one) and find the centre of those (store centre, bottom left corner and top right corner lists(x,y) in setq ) 

Thanks 

Abhi

[dbhunia]

Try this......(Only for non rotated rectangles)...... Roughly coded....

(defun c:test (/ ent obj ll ur mpt point lst N sset)
(vl-load-com)
(Setq sset (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(repeat (setq N (sslength sset))
	(setq ent (ssname sset (setq N (- N 1))))
	(setq obj (vlax-ename->vla-object ent))
	(vla-getboundingbox obj 'll 'ur)
	(setq ll (vlax-safearray->list ll))
	(setq ur (vlax-safearray->list ur))
	(setq mpt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5)))
	(setq point (list mpt ll ur))
	(setq lst (cons point lst))
)
(print lst)
(princ)
)

[dbhunia · Accepted solution]

Try this......(Only for non rotated rectangles)......

(defun c:test (/ N ent ptlst ll lr ul ur pt mpt point lst sset)
(vl-load-com)
(setq sset (ssget '((0 . "LWPOLYLINE") (90 . 4) (70 . 1))))
(repeat (setq N (sslength sset))
	(setq ent (ssname sset (setq N (- N 1)))
	      ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))
  	      ll (apply 'mapcar (cons 'min ptlst))
              ur (apply 'mapcar (cons 'max ptlst))
              ul (list (car ur)(cadr ll))
              lr (list (car ll)(cadr ur))
	      pt (list ll lr ur ul)
   	)
	(if (= 4 (length (complst pt ptlst)))
	    (progn
		(setq mpt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
		      point (list mpt ll ur)
		      lst (cons point lst)
		)		
	    )	
	)
)
(princ lst)
(princ)
)
(defun complst (l1 l2)
  (if l1 
     (if (member (car l1) l2)
         (cons (car l1) (complst (cdr l1) l2))
         (complst (cdr l1) l2)
     )
  )
)

[_gile]

Hi,

Here's my 2 cents.

(defun rectCenters (/ midPt massoc ss i pts lst)

  (defun midPt (p1 p2)
    (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.))) p1 p2)
  )

  (defun massoc (key alst)
    (if (setq alst (member (assoc key alst) alst))
      (cons (cdar alst) (massoc key (cdr alst)))
    )
  )

  (if (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
    (repeat (setq i (sslength ss))
      (setq pts (massoc 10 (entget (ssname ss (setq i (1- i)))))
            lst (cons (midPt (car pts) (caddr pts)) lst)
      )
    )
  )
)

[_gile · Accepted solution]

A slightly different algorithm using the barycenter of the quadrilateral.

(defun rectCenters (/ massoc ss i pts lst)

  (defun massoc (key alst)
    (if (setq alst (member (assoc key alst) alst))
      (cons (cdar alst) (massoc key (cdr alst)))
    )
  )

  (if (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&") (70 . 1))))
    (repeat (setq i (sslength ss))
      (setq pts (massoc 10 (entget (ssname ss (setq i (1- i)))))
            lst (cons (mapcar '/ (apply 'mapcar (cons '+ pts)) '(4. 4.)) lst)
      )
    )
  )
)

[Anonymous]

Thank you

[Anonymous]

Thank you