Nikon Posted Friday at 08:05 PM Posted Friday at 08:05 PM (edited) 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 Friday at 09:05 PM by Nikon Quote
Saxlle Posted Saturday at 08:53 AM Posted Saturday at 08:53 AM 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. 1 Quote
Nikon Posted Saturday at 09:16 AM Author Posted Saturday at 09:16 AM 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.. Quote
GLAVCVS Posted Saturday at 09:35 AM Posted Saturday at 09:35 AM 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 1 Quote
Nikon Posted Saturday at 09:44 AM Author Posted Saturday at 09:44 AM (edited) 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 Saturday at 09:59 AM by Nikon Quote
GLAVCVS Posted Saturday at 11:38 AM Posted Saturday at 11:38 AM 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)))) ) ) ) ) 1 Quote
Nikon Posted Saturday at 12:09 PM Author Posted Saturday at 12:09 PM 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... Quote
Nikon Posted Saturday at 01:58 PM Author Posted Saturday at 01:58 PM (edited) 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 Saturday at 02:51 PM by Nikon Quote
Lee Mac Posted Saturday at 05:11 PM Posted Saturday at 05:11 PM A similar program can be found here - just change POINT to CIRCLE. 1 Quote
Nikon Posted Saturday at 06:02 PM Author Posted Saturday at 06:02 PM (edited) 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 Saturday at 06:04 PM by Nikon Quote
GLAVCVS Posted Saturday at 07:20 PM Posted Saturday at 07:20 PM Define 'problematic MTEXT', please Quote
Nikon Posted Saturday at 07:34 PM Author Posted Saturday at 07:34 PM (edited) 13 hours ago, GLAVCVS said: Define 'problematic MTEXT', please How Define? What do I need to do? Texts with "crooked" formatting: Edited Sunday at 09:17 AM by Nikon Quote
GLAVCVS Posted Saturday at 08:27 PM Posted Saturday at 08:27 PM 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)) ) 1 Quote
GLAVCVS Posted Saturday at 08:33 PM Posted Saturday at 08:33 PM 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 1 Quote
Nikon Posted Saturday at 09:05 PM Author Posted Saturday at 09:05 PM 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)))) ) ) ) ) Quote
Nikon Posted Sunday at 09:16 AM Author Posted Sunday at 09:16 AM 8 minutes ago, GLAVCVS said: Delete that semicolon My carelessness, I'm sorry. It's all right now. Thanks! 1 Quote
Lee Mac Posted Sunday at 01:59 PM Posted Sunday at 01:59 PM 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. 1 Quote
Nikon Posted Sunday at 02:11 PM Author Posted Sunday at 02:11 PM 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... Quote
Steven P Posted Sunday at 09:22 PM Posted Sunday at 09:22 PM 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. 1 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.