Move text, mtext, block or circle to center rectang?

[tuantrinhdp]

Hello everyone. 
I have a problem, i want to move text, mtext or block or circle to center rectang. 
Can anyone help me write lisp, please?

 

TEST.dwg

[Steven P]

This should put text to the centre of 2 points, if you select diagonally opposite corners of a rectangle it will put the selected text into its centre. Command txt2rect. Also including txt2circ.

 

There is a function in there which returns the centre of the 2 selected points, use that maybe to line up a block or circle to the centre of the points.

 

There will be a more attractive solution along shortly

 

(defun c:txt2rect ( / ptc centretext)
  (setq ptc (rectcentre))
  (txt2centre ptc)
)
(defun c:txt2circ ( / ptc)
  (setq ptc (circcentre))
  (txt2centre ptc)
)

(defun txt2centre ( ptc / txtset alignment myrotation Edata ptx pty mycons NewInsData NewData entlist entwidth newwidth elist sel endloop)
  (princ "\nSelect Text")
  (setq txtset (ssget '((0 . "*TEXT"))))
  (setq Edata (entget (ssname txtset 0)))
  (setq myrotation (cdr (assoc 50 Edata)))

  (setq Newdata (subst (cons 50 0) (assoc 50 Edata) Edata) )
  (entmod Newdata)

  (setq alignment (gettextalign txtset))
  (setq ptx (nth 0 (assoc 10 Edata)))
  (setq pty (nth 1 (assoc 10 Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)

  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq NewInsData (cons mycons ptc) )
  (setq Newdata (subst NewInsdata (assoc mycons Edata) Edata) )

  (if (= "TEXT" (cdr (assoc 0 Edata)))
    (progn
      (entmod Newdata)
    )
  )
  (if (/= "TEXT" (cdr (assoc 0 Edata))) ;;mtext etc.
    (progn
      (setq entlist Edata) ;;could be Edata
      (setq entwidth entlist)
      (setq newwidth (cdr (assoc 42 entlist))) ;;text line width assoc 41 for mtext 'box' width
      (if (< newwidth (cdr (assoc 42 entwidth)))(setq newwidth (+ MWidth newwidth)))
      (if (= (cdr (assoc 41 entlist)) 0)(setq newwidth 0)) ;;fix for zero width mtexts

      (setq elist (subst (cons 41 newwidth)(assoc 41 Edata) Edata)) ;;if txt this is width factor, mtext its text width
      (setq elist (subst (cons mycons ptc)(assoc mycons elist) elist))
      (setq elist (subst (cons 50 myrotation)(assoc 50 elist) elist))

      (entmod elist)
    )
  )

  (command "_.justifytext" txtset "" alignment)

  (princ)
)

(defun rectcentre ( / pt1 pt2 ptx pty ptz ptc)
  (setq pt1 (getpoint "\nPick Corner 1"))
  (setq pt2 (getpoint "\nPick Corner 2"))
  (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) )
  (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) )
  (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) )
  (setq ptc (list ptx pty ptz))
  ptc
)
(defun circcentre ( / circ ent ptc)
  (princ "\nSelect Circle")
  (setq circ (ssget '((0 . "CIRCLE"))))
  (setq ent (entget (ssname circ 0)))
  (setq ptc (assoc 10 ent))
  (setq ptc (list (nth 1 ptc)(nth 2 ptc)(nth 3 ptc)))
  ptc
)
(defun gettextalign ( txtset / txtset Edata ptx_old pty_old pty_new ptx_new mycons)
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)
  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq ptx_old (nth 1 (assoc mycons Edata)))
  (setq pty_old (nth 2 (assoc mycons Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq ptx_new (nth 1 (assoc mycons Edata)))
  (setq pty_new (nth 2 (assoc mycons Edata)))

  (if (< ptx_old ptx_new)(setq alignx "L"))
  (if (> ptx_old ptx_new)(setq alignx "R"))
  (if (= ptx_old ptx_new)(setq alignx "C"))

  (if (> pty_old pty_new)(setq aligny "T"))
  (if (< pty_old pty_new)(setq aligny "B"))
  (if (= pty_old pty_new)(setq aligny "M"))

  (setq xyalign (strcat aligny alignx))
  (command "_.justifytext" txtset "" xyalign)

  xyalign
)

 

[mhupp]

Set Mtext mid center justified. for the circle & hatch make them a block with the base point in mid of circle.

 

;;----------------------------------------------------------------------------;;
;; Copy item to Multiple locations
(defun C:COPYOBJ (/ ent BP SS obj LL UR MPT)
  (vl-load-com)
  (setq obj (car (entsel "\nObject to copy: ")))
  (setq BP (cdr (assoc 10 (entget obj))))
  (if (setq SS (ssget))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (vlax-ename->vla-object ent))
      (vla-getboundingbox ent 'minpt 'maxpt)
      (setq LL (vlax-safearray->list minpt)
            UR (vlax-safearray->list maxpt)
      )
      (setq MPT (polar LL (angle LL UR) (/ (distance LL UR) 2)))
      (vl-cmdf "_.Copy" obj "" "_non" BP "_non" MPT)
    )
  )
  (princ)
)

Edited November 11, 2021 by mhupp
updated code with "_non"

[tuantrinhdp]

@mhupp I do  for the circle & hatch make them a block, after i tested have error. Can you help me edit? 

[mhupp]

Your Base point for the block is mid of circle? looks like it worked on some but not others?

 

Forgot the "_non" when feeding points to copy command.

I think its a bug but working as intended. If your zoomed out even tho your telling AutoCAD the points it will snap to nearest objects like shown.

I think this happens even if you set 'osmode to 0.

I have updated my code should work now.

 

Edited November 11, 2021 by mhupp

[tuantrinhdp]

I did it, thank you so much.