Align text (or mtext) to the center of the circles

February 7

I want to get a code that allow me to align texts (or mtexts) to the center of circles.

These texts consist of a single letter or number and serve to indicate the axes.
I want to select several circles with texts using a frame and align the center of the texts to the center of the circles.
The mtexts need to be converted to texts with a "Mid-center" alignment.
The height and style of the texts do not need to be changed.
But I need help to continue...

(defun c:AlignTxtToCircle (/ circle textObj mtextObj centerPoint textHeight circles texts)
  (defun get-circle-and-text ()
    (setq circle (car (entsel "\nSelect the circle with the text (or press Enter to finish): ")))
    (if circle
      (progn
        
        (setq textObj (car (entsel "\nSelect text or mtext: ")))
        (if textObj      
          (list circle textObj)
          nil))
      nil))
  (setq circles '() texts '())

  (while 
    (setq result (get-circle-and-text))
    result

    (setq circles (cons (car result) circles))
    (setq texts   (cons (cadr result) texts)))
)
..........................

Edited February 7 by Nikon

February 8

Hey @Nikon

Give a try with this:

; **********************************************************************
; Functions     :  TTC (TEXT TO CIRCLE)
; Description   :  Place a TEXT or MTEXT entity inside the Circle
; Author        :  SAXLLE
; Date          :  February 08, 2025
; **********************************************************************

(prompt "\nTo run a LISP type: TTC")

(defun c:TTC ( / flag entOne entSecond objSecond circleCenter ptMin ptMax midPt ss textWidth_old textHeight strLength newWidth)
  
  (setq flag T)
  
  (while (= flag T)
    
    (setq entOne (car (entsel "\nSelect the CIRCLE:"))
	  entSecond (car (entsel "\nSelect the TEXT or MTEXT:"))
	  )
    
    (while (or (= entOne nil) (not (or (= "CIRCLE" (cdr (assoc 0 (entget entOne)))))))
      (if (= entOne nil)
	(progn
	  (prompt "\nNothing was selected. Try again...")
	  (setq entOne (car (entsel "\nSelect the CIRCLE:")))
	  (princ)
	  )
	(progn
	  (prompt "\nSelected entity must be CIRCLE. Try again...")
	  (setq entOne (car (entsel "\nSelect the CIRCLE:")))
	  (princ)
	  )
	)
      )
    
    (while (or (= entSecond nil) (not (or (= "TEXT" (cdr (assoc 0 (entget entSecond)))) (= "MTEXT" (cdr (assoc 0 (entget entSecond)))))))
      (if (= entSecond nil)
	(progn
	  (prompt "\nNothing was selected. Try again...")
	  (setq entSecond (car (entsel "\nSelect the TEXT or MTEXT:")))
	  (princ)
	  )
	(progn
	  (prompt "\nSelected entity must be TEXT or MTEXT. Try again...")
	  (setq entSecond (car (entsel "\nSelect the TEXT or MTEXT:")))
	  (princ)
	  )
	)
      )
    
    (cond
      ((= (cdr (assoc 0 (entget entSecond))) "TEXT")
       
       (setq objSecond (vlax-ename->vla-object entSecond)
	     circleCenter (cdr (assoc 10 (entget entOne)))
	     )
       
       (vla-getboundingbox objSecond 'minPt 'maxPt)
       
       (setq ptMin (vlax-safeArray->list minPt)
	     ptMax (vlax-safeArray->list maxPt)
	     )
       
       (setq midPt (polar ptMin (angle ptMin ptMax) (/ (distance ptMin ptMax) 2)))
       
       (setq ss (ssget "F" (list ptMin ptMax) '((0 . "TEXT"))))
       
       (command-s "_move" ss "" midPt circleCenter)
       
       )
      
      ((= (cdr (assoc 0 (entget entSecond))) "MTEXT")
       
       (setq objSecond (vlax-ename->vla-object entSecond)
	     circleCenter (cdr (assoc 10 (entget entOne)))
	     )
       
       (setq textWidth_old (cdr (assoc 41 (entget entSecond)))
	     textHeight (cdr (assoc 40 (entget entSecond)))
	     strLength (strlen (cdr (assoc 1 (entget entSecond))))
	     newWidth (- (* textHeight strLength) (fix textHeight))
	     )
       
       (entmod (subst (cons 41 newWidth) (cons 41 textWidth_old) (entget entSecond)))
       
       (vla-getboundingbox objSecond 'minPt 'maxPt)
       
       (setq ptMin (vlax-safeArray->list minPt)
	     ptMax (vlax-safeArray->list maxPt)
	     )
       
       (setq midPt (polar ptMin (angle ptMin ptMax) (/ (distance ptMin ptMax) 2)))
       
       (setq ss (ssget "F" (list ptMin ptMax) '((0 . "MTEXT"))))
       
       (command-s "_move" ss "" midPt circleCenter)
       
       )
      )
    
    (prompt (strcat "\nSelected " (cdr (assoc 0 (entget entSecond))) " was placed in the CIRCLE!\nTo EXIT, press the ESC key!"))
    (princ)
    
    )
  )

I hope it will be helpful.

Best regards.

February 8

21 minutes ago, Saxlle said:

Hey @Nikon

Give a try with this:

Thanks a lot, it's a good start,

but the texts are not aligned "Middle to center", that's why the centers of the text and the circle don't align..

February 8

Hi I think you should create a function that converts any TEXT or MTEXT into center-justified text.
If it's a text, change its 'alignment' property to 'acAlignmentCenter'.
And, if it's an MTEXT, create a new text, set its 'alignment' property the same way and delete the original MTEXT.
Then the rest will be easy

February 8

22 minutes ago, GLAVCVS said:

Hi I think you should create a function that converts any TEXT or MTEXT into center-justified text.
If it's a text, change its 'alignment' property to 'acAlignmentCenter'.
And, if it's an MTEXT, create a new text, set its 'alignment' property the same way and delete the original MTEXT.
Then the rest will be easy

Unfortunately, it's not easy for me, I don't understand how to combine the center of the text and the center of the circle in the code...

I think there is no need to delete the mtext, just explode mtext and then align it...

Edited February 8 by Nikon

February 8

This should work for you
If you don't want to delete the MTEXT, make sure to undo the '(vla-delete... ' line of code

(defun c:AlignTxtToCircle (/	       circle	   textObj
			   mtextObj    centerPoint textHeight
			   circles     texts
			  )
  (defun get-circle-and-text ()
    (princ
      "\nSelect the circle with the text (or press Enter to finish): "
    )
    (setq circle
	   (ssget "_+.:E:S" '((0 . "CIRCLE")))
    )
    (if	circle
      (progn
	(princ "\nSelect text or mtext: ")
	(setq textObj (ssget "_+.:E:S" '((0 . "*TEXT"))))
	(if textObj
	  (list (ssname circle 0) (ssname textObj 0))
	  nil
	)
      )
      nil
    )
  )
  (defun obj->txMC (ent	/ lstent tipObj	vlaEnt texto estilo capa ang
		    ptins altura)
    (cond
      ((= (setq tipObj (cdr (assoc 0 (setq lstent (entget ent)))))
	  "TEXT"
       )
       (vlax-put-property
	 (vlax-ename->vla-object ent)
	 "Alignment"
	 10
       )
       (vlax-put-property
	 (vlax-ename->vla-object ent)
	 "TextAlignmentPoint"
	 (VLAX-3D-POINT (cdr (assoc 10 lstent)))
       )
       ent
      )
      ((= tipObj "MTEXT")
       (setq texto  (cdr (assoc 1 lstent))
	     estilo (cdr (assoc 7 lstent))
	     capa   (cdr (assoc 8 lstent))
	     ang    (cdr (assoc 50 lstent))
	     ptins  (cdr (assoc 10 lstent))
	     altura (cdr (assoc 40 lstent))
	     vlaEnt (vla-AddText
		      (vla-get-modelspace
			(vla-get-activedocument
			  (vlax-get-acad-object)
			)
		      )
		      texto
		      (VLAX-3D-POINT ptins)
		      altura
		    )
       )
       (vlax-put vlaEnt "ROTATION" ang)
       (vlax-put vlaEnt "LAYER" capa)
       (vlax-put vlaEnt "STYLENAME" estilo)
       (vlax-put-property vlaEnt "Alignment" 10)
       (vlax-put-property
	 vlaEnt
	 "TextAlignmentPoint"
	 (VLAX-3D-POINT ptins)
       )
       (vla-delete (vlax-ename->vla-object ent))
       (vlax-vla-object->ename vlaEnt)
      )
      (T
       (alert "Tipo de objeto no es TEXT ni MTEXT")
       nil
      )
    )
  )

  (while
    (setq result (get-circle-and-text))
    (if (setq textObj (obj->txMC (cadr result)))
      (progn
        (setq circle (car result))
	(vl-cmdf "_move" textObj "" (cdr (assoc 11 (entget textObj))) (cdr (assoc 10 (entget circle))))
     )
    )
  )
)

February 8

29 minutes ago, GLAVCVS said:

This should work for you
If you don't want to delete the MTEXT, make sure to undo the '(vla-delete... ' line of code

Thank you for your time. The code works perfectly.
I didn't think the code could be very complicated...

I really appreciate your help!

Is it possible to select multiple circles and texts using a frame?
But there is no urgent need for this, just to speed up the process...

February 8

For those who will use this code, there is a small warning.
I noticed a small problem, some mtexts need to be formatted in advance,
this is a bit inconvenient, since we can't see which mtext is problematic,
otherwise, the mtext is converted to text, aligned, but looks like this:

Edited February 8 by Nikon

February 8

A similar program can be found here - just change POINT to CIRCLE.

February 8

52 minutes ago, Lee Mac said:

A similar program can be found here - just change POINT to CIRCLE.

Thanks for the link, it's very convenient that you can select several objects with a frame, but the code only works with texts that have a "middle-center" alignment. It does not work with the mtext and does not change the alignment to the "middle".

;; Text 2 Point - Lee Mac 2012
;; Prompts for a selection of Text and Point entities and moves
;; each Text entity to the nearest (2D distance) Point entity in the set.
;; https://www.cadtutor.net/forum/topic/37515-moving-text-block-to-adjacent-point/#comment-306285
;; Retains existing Text elevation.
;; Binding the center of the text to the center of the circle
(defun c:txt2pt-circle ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )

 (defun _textinsertion ( elist )
 (if
 (and
 (zerop (cdr (assoc 72 elist)))
 (zerop (cdr (assoc 73 elist)))
 )
 (cdr (assoc 10 elist))
 (cdr (assoc 11 elist))
 )
 )

 ; (if (setq sel (ssget "_:L" '((0 . "POINT,TEXT"))))
(if (setq sel (ssget "_:L" '((0 . "CIRCLE,TEXT"))))
 (progn
 (repeat (setq inc (sslength sel))
 (setq ent (entget (ssname sel (setq inc (1- inc)))))
 ; (if (eq "POINT" (cdr (assoc 0 ent)))
(if (eq "CIRCLE" (cdr (assoc 0 ent)))
 (setq lst (cons (cdr (assoc 10 ent)) lst))
 (setq txt (cons (cons (_textinsertion ent) ent) txt))
 )
 )
 (foreach ent txt
 (setq ins (list (caar ent) (cadar ent)))
 (if (setq pnt (vl-some '(lambda ( pnt ) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst))
 (setq lst (vl-remove pnt lst))
 (progn
 (setq di1 (distance ins (list (caar lst) (cadar lst)))
 mpt (car lst)
 )
 (foreach pnt (cdr lst)
 (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1)
 (setq di1 di2
 mpt pnt
 )
 )
 )
 (setq pnt (list (car mpt) (cadr mpt) (caddar ent))
 dxf (cdr ent)
 dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf)
 dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf)
 )
 (entmod dxf)
 (setq lst (vl-remove mpt lst))
 )
 )
 )
 )
 )
 (princ)
)
(vl-load-com) (princ)

Edited February 8 by Nikon

February 8

Define 'problematic MTEXT', please

February 8

13 hours ago, GLAVCVS said:

Define 'problematic MTEXT', please

How Define? What do I need to do?

Texts with "crooked" formatting:

Edited February 9 by Nikon

February 8

Simply: replace, in the function 'obj->txMC', '(cdr (assoc 1 lstent))' with...

(if (setq pos (vl-string-search ";" (cdr (assoc 1 lstent))))
		     (if (setq pos (vl-string-search
				     "}"
				     (setq texto
					    (substr (cdr (assoc 1 lstent))
						    (+ pos 2)
					    )
				     )
				   )
			 )
		       (substr texto 1 pos)
		       texto
		     )
		     (cdr (assoc 1 lstent))
		   )

February 8

Important: the case of MTEXTs on several lines is NOT contemplated in the code
That is to say: the code will only work well with MTEXTs that contain all their text on a single line

February 8

25 minutes ago, GLAVCVS said:

Simply: replace, in the function 'obj->txMC', '(cdr (assoc 1 lstent))' with...

I must be doing something wrong...
; error: syntax error
command: ALIGNTXTTOCIRCLE-GL1
OBJ->TXMC

;; AlignTxtToCircle  GLAVCVS  08.02.2025
;; https://www.cadtutor.net/forum/topic/96350-align-text-or-mtext-to-the-center-of-the-circles/
(defun c:AlignTxtToCircle-GL1 (/ circle textObj
 mtextObj centerPoint textHeight
 circles texts
 )
 (defun get-circle-and-text ()
 (princ
 "\nSelect the circle with the text (or press Enter to finish): "
 )
 (setq circle
 (ssget "_+.:E:S" '((0 . "CIRCLE")))
 )
 (if circle
 (progn
 (princ "\nSelect text or mtext: ")
 (setq textObj (ssget "_+.:E:S" '((0 . "*TEXT"))))
 (if textObj
 (list (ssname circle 0) (ssname textObj 0))
 nil
 )
 )
 nil
 )
 )
 (defun obj->txMC (ent / lstent tipObj vlaEnt texto estilo capa ang
 ptins altura)
 (cond
 ((= (setq tipObj (cdr (assoc 0 (setq lstent (entget ent)))))
 "TEXT"
 )
 (vlax-put-property
 (vlax-ename->vla-object ent)
 "Alignment"
 10
 )
 (vlax-put-property
 (vlax-ename->vla-object ent)
 "TextAlignmentPoint"
 (VLAX-3D-POINT (cdr (assoc 10 lstent)))
 )
 ent
 )
 ((= tipObj "MTEXT")
 (setq texto ; (cdr (assoc 1 lstent))
;(if (setq pos (vl-string-search ";" (cdr (assoc 1 lstent))))
 (if (setq pos (vl-string-search
 "}"
 (setq texto
 (substr (cdr (assoc 1 lstent))
 (+ pos 2)
 )
 )
 )
 )
 (substr texto 1 pos)
 texto
 )
 (cdr (assoc 1 lstent))
 )
 estilo (cdr (assoc 7 lstent))
 capa (cdr (assoc 8 lstent))
 ang (cdr (assoc 50 lstent))
 ptins (cdr (assoc 10 lstent))
 altura (cdr (assoc 40 lstent))
 vlaEnt (vla-AddText
 (vla-get-modelspace
 (vla-get-activedocument
 (vlax-get-acad-object)
 )
 )
 texto
 (VLAX-3D-POINT ptins)
 altura
 )
 )
 (vlax-put vlaEnt "ROTATION" ang)
 (vlax-put vlaEnt "LAYER" capa)
 (vlax-put vlaEnt "STYLENAME" estilo)
 (vlax-put-property vlaEnt "Alignment" 10)
 (vlax-put-property
 vlaEnt
 "TextAlignmentPoint"
 (VLAX-3D-POINT ptins)
 )
 (vla-delete (vlax-ename->vla-object ent))
 (vlax-vla-object->ename vlaEnt)
 )
 (T
 (alert "Tipo de objeto no es TEXT ni MTEXT")
 nil
 )
 )
 )

 (while
 (setq result (get-circle-and-text))
 (if (setq textObj (obj->txMC (cadr result)))
 (progn
 (setq circle (car result))
 (vl-cmdf "_move" textObj "" (cdr (assoc 11 (entget textObj))) (cdr (assoc 10 (entget circle))))
 )
 )
 )
)

February 9

Delete that semicolon

February 9

8 minutes ago, GLAVCVS said:

Delete that semicolon

My carelessness, I'm sorry. It's all right now. Thanks!

February 9

19 hours ago, Nikon said:

Thanks for the link, it's very convenient that you can select several objects with a frame, but the code only works with texts that have a "middle-center" alignment. It does not work with the mtext and does not change the alignment to the "middle".

The code is not made to order; it is a starting point from which you can learn and modify it to suit your requirements.

February 9

11 minutes ago, Lee Mac said:

The code is not made to order; it is a starting point from which you can learn and modify it to suit your requirements.

I don't think I can handle it...

February 9

This first one will justify Middle Centre where the calling function sends 'mc' for justification. One to keep handy and you can expand this to include other justifications such as Top, Middle Left, Bottom Right as more examples.

(defun c:jumc()
  (jut "mc")
)
(defun jut (just / var ent)
;;https://www.cadtutor.net/forum/topic/35569-text-justification-lisp/
 (princ (strcat "\nSelect Text"))
 (if (setq ss (ssget "_:L" '((0 . "ATTDEF,MTEXT,TEXT"))))
   (command "_.justifytext" ss "" just)
 )
  (princ)
)

Lees code above is quite simple and you should be able to put this in there to justify centre the text. Do the justification before moving.

Sign In

Align text (or mtext) to the center of the circles

Recommended Posts

Nikon

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

Saxlle

GLAVCVS

Posted Images

Saxlle

Nikon

GLAVCVS

Nikon

GLAVCVS

Nikon

Nikon

Lee Mac

Nikon

GLAVCVS

Nikon

GLAVCVS

GLAVCVS

Nikon

GLAVCVS

Nikon

Lee Mac

Nikon

Steven P

Join the conversation

ronjonp

Saxlle

GLAVCVS

Tutorials

Forums

Activity