Find center by 4 points

[Lukasvop1]

Hi guys, I realize I need tool like this, can you help?

This lisp "FC" should find center between 4 picked points and place block there.

-In lisp should be path to the block.
-Would be greate if there will be option set Scale factor of the block (similar like BREAKLINE (Express Tool)).

@komondormrex 

[komondormrex · Accepted solution]

hey there,

just select entities to set center of theirs bounding box.

(defun c:center_of_bounding_box (/ ename_sset llc urc b_llc b_urc block_size)
	(setq init_block_size (if (null init_block_size) (setq init_block_size '(10)) init_block_size))
	(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "D_Cross")))
		(progn
			(vla-addline (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0)) "D_Cross")
						 (vlax-3d-point '(-0.5 -0.5)) (vlax-3d-point '(0.5 +0.5))
			)
			(vla-addline (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0)) "D_Cross")
						 (vlax-3d-point '(-0.5 +0.5)) (vlax-3d-point '(0.5 -0.5))
			)
		)
	)
	(if (setq ename_sset (ssget))
		(progn
			(foreach object (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ename_sset))))
				(vla-getboundingbox object 'llc 'urc) 
				(setq llc (vlax-safearray->list llc) 
					  urc (vlax-safearray->list urc)
					  b_llc (if (null b_llc) llc (list (min (car b_llc) (car llc)) (min (cadr b_llc) (cadr llc))))
					  b_urc (if (null b_urc) urc (list (max (car b_urc) (car urc)) (max (cadr b_urc) (cadr urc))))
				)
			)
			(setq block_size (getreal (strcat "\nEnter block sizes <" (rtos (nth 0 init_block_size)) ">: "))
				  block_size (if (null block_size) (nth 0 init_block_size) block_size)
				  init_block_size (list block_size)
			)
			(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 (vlax-3d-point (mapcar '* '(0.5 0.5) (mapcar '+ b_urc b_llc))) 
							 "D_Cross" block_size block_size block_size 0
			)
		)
	)
	(princ)
)

[calderg1000 · Accepted solution]

Regards @Lukasvop1 

Try this code, to get the average point of abscissa and ordinate, you can select the points in any order...

;;;___
(defun c:pxy(/ p1 p2 p3 p4 pc i j m n)
  (setvar 'pdmode 3)
  (setvar 'pdsize 0.5)
  (setq p1 (getpoint "\nPick Point 1")
        p2 (getpoint p1 "\nPick Point 2")
        p3 (getpoint p2 "\nPick Point 3")
        p4 (getpoint p3 "\nPick Point 4")
  )
  (setq lp (vl-sort (list p1 p2 p3 p4) '(lambda (a b) (< (car a) (car b)))))
  (entmakex (list '(0 . "point")
                  (cons 10
                        (list (apply '(lambda (i j) (* (+ i j) 0.5))
                                     (list (caar lp) (car (cadddr lp)))
                              )
                              (apply '(lambda (m n) (* (+ m n) 0.5))
                                     (list (cadr (cadr lp)) (cadr (caddr lp)))
                              )
                        )
                  )
            )
  )
)

[Lukasvop1]

Wow, this is perfect.

[Lukasvop1]

Thank you

[calderg1000 · Accepted solution]

Saludos @Lukasvop1 

Here my version to find the geometric center, selecting the entities that define the bounding box...

;;;___
(defun c:pxys (/ lobj j pmx pmn lp lf lx ly pmin pmax)
  (setvar 'pdmode 3)
  (setvar 'pdsize 0.2)
  (setq
    lobj (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*"))))))
  )
  (foreach j lobj
    (vla-getboundingbox (vlax-ename->vla-object j) 'pmx 'pmn)
    (setq lp (list (vlax-safearray->list pmx)
                   (vlax-safearray->list pmn)
             )
    )
    (setq lf (cons lp lf))
  )
  (setq lf   (apply 'append lf)
        lx   (vl-sort lf '(lambda (x y) (< (car x) (car y))))
        ly   (vl-sort lf '(lambda (x y) (< (cadr x) (cadr y))))
        pmin (list (car (car lx)) (cadr (car ly)))
        pmax (list (car (last lx)) (cadr (last ly)))
  )
  (entmakex
    (list '(0 . "point")
          (cons 10
                (mapcar '(lambda (z k) (* (+ z k) 0.5)) pmin pmax)
          )
    )
  )
  (princ)
)

[Lukasvop1]

Perfect, thank you.