Leaderboard

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

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

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

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

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

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.

(defun c:lixt ( / i s ) (if (setq s (ssget '((0 . "POINT")))) (repeat (setq i (sslength s)) (princ (apply 'strcat (mapcar 'strcat '("\n\tX=\t" "\tY=\t") (mapcar 'rtos (cdr (assoc 10 (entget (ssname s (setq i (1- i))))))) ) ) ) ) ) (princ) )