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

February 14

4 hours ago, Nikon said:

Try the two codes mtxt-circle-centre and txt2pt-circle, they work as they should, with minor limitations...

I would be very happy if someone could help me combine two lisps into one.
The code needs to select several mtexts and texts in circles using the frame, and combine the center of the texts and circles.
The mtext needs to be explode and change the alignment to mc.

;; 1 code for texts and circles
;; 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 )

(setq ss (ssget "_:L" '((0 . "*TEXT")))) (vl-cmdf "_justifytext" ss "" "_mc") ; ?

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

+ + +

;; 2 code for mtexts and circles
(defun c:mtxt-circle-centre ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )
  (setq ss       (ssget '((0 . "MTEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)
  
  (setvar 'CMDECHO 0)
  
  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))))
      (vl-cmdf "_justifytext" "_P" "" "_mc")
    ) ;_ end repeat
  ) ;_ end if

 (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 14 by Nikon

February 14

5 hours ago, Nikon said:

Me parece que su código es un poco complicado, probablemente haya una forma más fácil,
como el programa Text 2 Point de Lee Mac.
;; Text 2 Point - Lee Mac 2012
;; Solicita una selección de entidades de Texto y Punto y mueve
;; cada entidad de Texto a la entidad de Punto más cercana (distancia 2D) en el conjunto.
;; Conserva la elevación de Texto existente.
(defun c:txt2pt....

La opción <Sí> no funciona aquí:
¿Quieres analizar círculo por círculo? [ N o/< Sí >]:
Los textos están posicionados incorrectamente.

I just ran the code on your drawing and it works fine.

February 14

The first video shows the option to run the code on all affected circles and texts, without asking the user.
The second video shows the option to have the user confirm (by pressing 'Y', ENTER or 'K' to skip), circle by circle, whether the text to be moved is correct.
This option may be useful in some cases.

Anyway, I have changed the code to override the "OSMODE" variable during execution, just in case.

February 14

11 minutes ago, GLAVCVS said:

I just ran the code on your drawing and it works fine.

Yes, indeed, your code works. Thanks!

February 14

20 hours ago, GLAVCVS said:

A variation of the original

(defun c:AlignTxtToCircleAllDrawing (/ n conj conj1 ent ent1 lstent pto rad pt1 pt2 x pto selEnt distMin AlignTxtToCircle 1x1? osmant)
  (defun AlignTxtToCircle (circle      textObj	   /
			   mtextObj    centerPoint textHeight
			   circles     texts       opt centroTexto
			  )
    (defun centroTexto (lstent / cajatx difx dify SO SE NE NO ptC)
      (if (= (cdr (assoc 0 lstent)) "MTEXT")
	(setq NO (cdr (assoc 10 lstent))
	      ptC (list (+ (car NO) (/ (cdr (assoc 41 lstent)) 2.0))
		       (- (cadr NO) (/ (cdr (assoc 40 lstent)) 2.0))
		  )
	)
        (setq cajatx (textbox lstent)
	      difx   (- (car (cadr cajatx)) (car (car cajatx)))
	      dify   (- (cadr (cadr cajatx)) (cadr (car cajatx)))
	      SO     (polar (cdr (assoc 10 lstent))
			  (- (cdr (assoc 50 lstent)) (/ pi 2))
			  (abs (cadr (car cajatx)))
		     )
	      NE     (polar (polar so (cdr (assoc 50 lstent)) difx) (+ (cdr (assoc 50 lstent)) (/ pi 2)) dify)
	      ptC (polar SO (angle SO NE) (/ (distance SO NE) 2.0))
        )
      )
      ptC
    )
    (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  (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
	)
      )
    )
    (redraw selEnt 3)
    (if 1x1?
      (grdraw
        (centroTexto (entget selEnt))
        (cdr (assoc 10 (entget ent)))
        1
        2
      )
    )
    (initget 1 "SKIP SELECT YES")
    (if (or
	  (not 1x1?)
	  (member (setq opt (strcase (getstring "\n*** Align this text? [sKip/Select other/<Yes>] : ")))
		'("Y" "")
          )
	)
      (if (or
	    (and selEnt (setq textObj (obj->txMC selEnt)))
	    (and (setq selEnt (car (entsel "\nText not found. Select text..."))) (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT") (setq textObj (obj->txMC selEnt)))
	  )
	(vl-cmdf "_move"
		 textObj
		 ""
		 (cdr (assoc 11 (entget textObj)))
		 (cdr (assoc 10 (entget ent)))
	)
	(princ "\n*** OMITED ***")
      )
      (if (and
	    (not (redraw selEnt 4))
	    (member opt '("S" "SELECT"))
	  )
	(if (and (setq selEnt (car (entsel)))
		 (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT")
	    )
	  (if (and
		(not (redraw selEnt 3))
		(setq textObj (obj->txMC selEnt))
	      )
	    (vl-cmdf "_move"
		     textObj
		     ""
		     (cdr (assoc 11 (entget textObj)))
		     (cdr (assoc 10 (entget ent)))
	    )
	  )
	)
      )
    )
    (redraw selEnt 4)
  )
  (setq n 0 osmant (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (princ "\nSelect circles...")
  (if (setq conj (ssget '((0 . "CIRCLE") (8 . "*"))))
    (progn
      (initget 1 "NO YES")
      (setq 1x1? (getkword "\nDo you want analyze circle by circle? [No/<Yes>]: "))
      (if (= 1x1? "YES")
	(setq 1x1? T)
	(setq 1x1? nil)
      )
      (while (setq ent (ssname conj n))
        (setq lstent (entget ent)
	      pto (cdr (assoc 10 lstent))
	      rad (cdr (assoc 40 lstent))
	      selEnt nil
	      distMin nil
	      n (+ n 1)
        )
	(if 1x1?
          (vl-cmdf "_zoom" (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0)))) (setq pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0)))))
	  (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0)))
		pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0)))
	  )
	)
        (if (setq conj1 (ssget "_W" pt1 pt2 '((0 . "*TEXT"))))
  	  (progn
	    (foreach ent1 (mapcar 'cadr (vl-remove-if-not (function (lambda (x) (member (car x) '(0 2 3)))) (ssnamex conj1)))
	      (if distMin
	        (if (< (setq dist (distance pto (setq pto1 (cdr (assoc 10 (entget ent1)))))) distmin)
	          (setq selEnt ent1 distMin dist)
	        )
	        (setq distMin (distance pto (cdr (assoc 10 (entget ent1))))
		      selEnt ent1
	        )
	      )
	    )
	    (AlignTxtToCircle ent selEnt)
	    (redraw)
	  )
	)
      )
    )
  )
  (setvar "OSMODE" osmant)
  (redraw)
  (princ)
)

I have updated the code in the original post.

February 14

Here's my take on it:

(defun c:foo (/ lm:unformat b el p r s sp tx)
  (cond
    ((setq s (ssget ":L" '((0 . "CIRCLE"))))
     (cond ((null (tblobjname "block" "Bubble"))
	    (entmake '((0 . "BLOCK")
		       (100 . "AcDbEntity")
		       (67 . 0)
		       (8 . "0")
		       (100 . "AcDbBlockReference")
		       (66 . 1)
		       (2 . "Bubble")
		       (10 0. 0. 0.)
		       (70 . 2)
		      )
	    )
	    (entmake '((0 . "CIRCLE")
		       (100 . "AcDbEntity")
		       (67 . 0)
		       (8 . "0")
		       (100 . "AcDbCircle")
		       (10 0. 0. 0.)
		       (40 . 1.)
		      )
	    )
	    (entmake '((0 . "ATTDEF")
		       (100 . "AcDbEntity")
		       (67 . 0)
		       (8 . "0")
		       (100 . "AcDbText")
		       (10 0. 0. 0.)
		       (40 . 0.75)
		       (1 . "")
		       (50 . 0)
		       (41 . 1)
		       (51 . 0)
		       (7 . "Standard")
		       (71 . 0)
		       (72 . 1)
		       (11 0. 0. 0.)
		       (100 . "AcDbAttributeDefinition")
		       (280 . 0)
		       (3 . "")
		       (2 . "#")
		       (70 . 8)
		       (73 . 0)
		       (74 . 2)
		       (280 . 1)
		      )
	    )
	    (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
	   )
	   (command "_.ATTSYNC" "_NAME" "BUBBLE")
     )
     ;;-------------------=={ UnFormat String }==------------------;;
     ;;                                                            ;;
     ;;  Returns a string with all MText formatting codes removed. ;;
     ;;------------------------------------------------------------;;
     ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
     ;;------------------------------------------------------------;;
     ;;  Arguments:                                                ;;
     ;;  str - String to Process                                   ;;
     ;;  mtx - MText Flag (T if string is for use in MText)        ;;
     ;;------------------------------------------------------------;;
     ;;  Returns:  String with formatting codes removed            ;;
     ;;------------------------------------------------------------;;
     (defun lm:unformat	(str mtx / _replace rx)
       (defun _replace (new old str)
	 (vlax-put-property rx 'pattern old)
	 (vlax-invoke rx 'replace str new)
       )
       (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
	 (progn	(setq str
		       (vl-catch-all-apply
			 (function
			   (lambda ()
			     (vlax-put-property rx 'global actrue)
			     (vlax-put-property rx 'multiline actrue)
			     (vlax-put-property rx 'ignorecase acfalse)
			     (foreach pair
				      '(("\032" . "\\\\\\\\")
					(" " . "\\\\P|\\n|\\t")
					("$1"
					 .
					 "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]"
					)
					("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
					("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
					("$1" . "[\\\\]({)|{")
				       )
			       (setq str (_replace (car pair) (cdr pair) str))
			     )
			     (if mtx
			       (_replace "\\\\"
					 "\032"
					 (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)
			       )
			       (_replace "\\" "\032" str)
			     )
			   )
			 )
		       )
		)
		(vlax-release-object rx)
		(if (null (vl-catch-all-error-p str))
		  str
		)
	 )
       )
     )
     (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (setq r (/ (cdr (assoc 40 (setq el (entget e)))) 2.))
       (setq p (cdr (assoc 10 el)))
       (cond ((setq
		tx (ssget "_C" (mapcar '- p (list r r r)) (mapcar '+ p (list r r r)) '((0 . "*TEXT")))
	      )
	      (setq r (* 2 r))
	      (setq b (vla-insertblock sp (vlax-3d-point p) "Bubble" r r r 0.))
	      (vla-put-textstring
		(car (vlax-invoke b 'getattributes))
		(lm:unformat (cdr (assoc 1 (entget (ssname tx 0)))) nil)
	      )
	      (entmod (append (entget (vlax-vla-object->ename b)) '((8 . "BUBBLE"))))
	      (entdel e)
	      (entdel (ssname tx 0))
	     )
       )
     )
    )
  )
  (princ)
)

Edited February 14 by ronjonp

February 14

3 hours ago, Nikon said:

Thank you, everyone! You give such complex codes, but the task is quite simple...

@Steven P, I haven't been able to get the code to work yet, but I'm still testing...

This should work, load it into CAD, command is txt2circ (or txt2rect, txt2cent).. single texts at a time, not the latest request

Txt2Circ.lsp

Edited February 14 by Steven P

February 14

Here is mine, with some help of Ronjonp's code.

Edited February 15 by Isaac26a

February 14

40 minutes ago, ronjonp said:

Here's my take on it:

You guys write codes at the speed of light, I take longer to test...

There are no problems with texts, but mtexts with crooked formatting are converted into attributes of this type:

Edited February 14 by Nikon

February 14

19 minutes ago, Isaac26a said:

Here is mine, with some help of Ronjonp's code.

It just happened...

February 14

3 minutes ago, Nikon said:

It just happened...

That's why it asks for a radius, you can change it to 3, 4 or any you want so it can search for a longer distance

February 14

Or you can change it in the code

         (if (not (setq d (getreal "\nType the search radius for the text <2.0>: ")))
           (setq d 2.)
         )

for:

         (if (not (setq d (getreal "\nType the search radius for the text <4.0>: ")))
           (setq d 4.)
         )

February 14

45 minutes ago, Steven P said:

This should work, load it into CAD, command is txt2circ (or txt2rect, txt2cent).. single texts at a time, not the latest request

Thanks!
For my task, it is better to highlight several text using a frame.

I am very grateful to everyone for participating in this topic!

Edited February 14 by Nikon

February 14

You did a great job, but I didn't get an answer to my question, how do I avoid multiple entry in this code? The code works fine, but I have to select the same objects 3 times. Can anyone answer?

I'm wondering how this particular code can be tweaked?

(defun c:txt_mtxt_center_circle ( / doc old_sett ss sel i inc ent txt lst pnt di1 di2 mpt ins dxf )
  (defun _textinsertion ( elist )
    (if
      (and
        (zerop (cdr (assoc 72 elist))) 
        (zerop (cdr (assoc 73 elist)))  
      )
      (cdr (assoc 10 elist))  
      (cdr (assoc 11 elist))  
    )
  )
 
  (setq doc      (vla-get-ActiveDocument (vlax-get-acad-object))
        old_sett (getvar 'CMDECHO)
  )
  (vla-StartUndoMark doc)
  (setvar 'CMDECHO 0)

   (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (progn
      (repeat (setq i (sslength ss))
        (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))))
      )
        (vl-cmdf "_JUSTIFYTEXT" "_P" "" "_MC")
    )
  )

   (if (setq ss (ssget "_:L" '((0 . "*TEXT"))))
    (vl-cmdf "_JUSTIFYTEXT" ss "" "_MC")
  )

   (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 "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 (p)
                       (if (equal ins (list (car p) (cadr p)) 1e-8)
                         p
                       )
                     )
                    lst
                  )
            )
         
          (setq lst (vl-remove pnt lst))
         
          (progn
            (setq di1 (distance ins (list (caar lst) (cadar lst)))
                  mpt (car lst)
            )
            (foreach p (cdr lst)
              (if (< (setq di2 (distance ins (list (car p) (cadr p)))) di1)
                (setq di1 di2
                      mpt p
                )
              )
            )
            (setq pnt (list (car mpt) (cadr mpt) (caddar ent)))
            (setq dxf (cdr ent))
           
            (setq dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf))
            (setq dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf))

                       (entmod dxf)

                      (setq lst (vl-remove mpt lst))
          )
        )
      )
    )
  )

   (vla-EndUndoMark doc)
  (setvar 'CMDECHO old_sett)
  (princ)
)

(vl-load-com)
(princ)

Edited February 14 by Nikon

February 14

2 hours ago, Nikon said:

You guys write codes at the speed of light, I take longer to test...

There are no problems with texts, but mtexts with crooked formatting are converted into attributes of this type:

Try the code again, I implemented Lee's unformat function.

February 14

34 minutes ago, ronjonp said:

Try the code again, I implemented Lee's
unformat function.

Yes, now the code has worked beautifully, unfortunately, when working with mtext, you always need to remember about formatting. Many thanks

February 15

19 hours ago, GLAVCVS said:

I have updated the code in the original post.

@GLAVCVS you can simplify the code a bit, remove the question:

Do you want analyze circle by circle? [No/<Yes>]:

Just select the objects and finish.

Your code is most suitable for my task, thank.

Saturday at 07:53 PM

(defun c:AlignTxtToCircleAllDrawing (/ n conj conj1 ent ent1 lstent pto rad pt1 pt2 x pto selEnt distMin AlignTxtToCircle 1x1? osmant)
  (defun AlignTxtToCircle (circle      textObj	   /
			   mtextObj    centerPoint textHeight
			   circles     texts       opt centroTexto
			  )
    (defun centroTexto (lstent / cajatx difx dify SO SE NE NO ptC)
      (if (= (cdr (assoc 0 lstent)) "MTEXT")
	(setq NO (cdr (assoc 10 lstent))
	      ptC (list (+ (car NO) (/ (cdr (assoc 41 lstent)) 2.0))
		       (- (cadr NO) (/ (cdr (assoc 40 lstent)) 2.0))
		  )
	)
        (setq cajatx (textbox lstent)
	      difx   (- (car (cadr cajatx)) (car (car cajatx)))
	      dify   (- (cadr (cadr cajatx)) (cadr (car cajatx)))
	      SO     (polar (cdr (assoc 10 lstent))
			  (- (cdr (assoc 50 lstent)) (/ pi 2))
			  (abs (cadr (car cajatx)))
		     )
	      NE     (polar (polar so (cdr (assoc 50 lstent)) difx) (+ (cdr (assoc 50 lstent)) (/ pi 2)) dify)
	      ptC (polar SO (angle SO NE) (/ (distance SO NE) 2.0))
        )
      )
      ptC
    )
    (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  (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
	)
      )
    )
    (redraw selEnt 3)
;;;    (if 1x1?
;;;      (grdraw
;;;        (centroTexto (entget selEnt))
;;;        (cdr (assoc 10 (entget ent)))
;;;        1
;;;        2
;;;      )
;;;    )
;;;    (initget 1 "SKIP SELECT YES")
    (if (or
	  (not 1x1?)
	  (member (setq opt (strcase (getstring "\n*** Align this text? [sKip/Select other/<Yes>] : ")))
		'("Y" "")
          )
	)
      (if (or
	    (and selEnt (setq textObj (obj->txMC selEnt)))
	    (and (setq selEnt (car (entsel "\nText not found. Select text..."))) (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT") (setq textObj (obj->txMC selEnt)))
	  )
	(vl-cmdf "_move"
		 textObj
		 ""
		 (cdr (assoc 11 (entget textObj)))
		 (cdr (assoc 10 (entget ent)))
	)
	(princ "\n*** OMITED ***")
      )
      (if (and
	    (not (redraw selEnt 4))
	    (member opt '("S" "SELECT"))
	  )
	(if (and (setq selEnt (car (entsel)))
		 (wcmatch (cdr (assoc 0 (entget selEnt))) "*TEXT")
	    )
	  (if (and
		(not (redraw selEnt 3))
		(setq textObj (obj->txMC selEnt))
	      )
	    (vl-cmdf "_move"
		     textObj
		     ""
		     (cdr (assoc 11 (entget textObj)))
		     (cdr (assoc 10 (entget ent)))
	    )
	  )
	)
      )
    )
    (redraw selEnt 4)
  )
  (setq n 0 osmant (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (princ "\nSelect circles...")
  (if (setq conj (ssget '((0 . "CIRCLE") (8 . "*"))))
    (progn
;;;      (initget 1 "NO YES")
;;;      (setq 1x1? (getkword "\nDo you want analyze circle by circle? [No/<Yes>]: "))
;;;      (if (= 1x1? "YES")
;;;	(setq 1x1? T)
;;;	(setq 1x1? nil)
;;;      )
      (while (setq ent (ssname conj n))
        (setq lstent (entget ent)
	      pto (cdr (assoc 10 lstent))
	      rad (cdr (assoc 40 lstent))
	      selEnt nil
	      distMin nil
	      n (+ n 1)
        )
	(if 1x1?
          (vl-cmdf "_zoom" (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0)))) (setq pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0)))))
	  (setq pt1 (list (- (car pto) (* rad 10.0)) (- (cadr pto) (* rad 10.0)))
		pt2 (list (+ (car pto) (* rad 10.0)) (+ (cadr pto) (* rad 10.0)))
	  )
	)
        (if (setq conj1 (ssget "_W" pt1 pt2 '((0 . "*TEXT"))))
  	  (progn
	    (foreach ent1 (mapcar 'cadr (vl-remove-if-not (function (lambda (x) (member (car x) '(0 2 3)))) (ssnamex conj1)))
	      (if distMin
	        (if (< (setq dist (distance pto (setq pto1 (cdr (assoc 10 (entget ent1)))))) distmin)
	          (setq selEnt ent1 distMin dist)
	        )
	        (setq distMin (distance pto (cdr (assoc 10 (entget ent1))))
		      selEnt ent1
	        )
	      )
	    )
	    (AlignTxtToCircle ent selEnt)
	    (redraw)
	  )
	)
      )
    )
  )
  (setvar "OSMODE" osmant)
  (redraw)
  (princ)
)

Saturday at 07:55 PM

I just disabled a few lines of code

Edited Saturday at 07:58 PM by GLAVCVS

Saturday at 08:10 PM

14 minutes ago, GLAVCVS said:

I just disabled a few lines of code

Thank you very much, it suits me perfectly!

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

GLAVCVS

GLAVCVS

Nikon

GLAVCVS

ronjonp

Steven P

Isaac26a

Nikon

Nikon

Isaac26a

Isaac26a

Nikon

Nikon

ronjonp

Nikon

Nikon

GLAVCVS

GLAVCVS

Nikon

Join the conversation

ronjonp

Saxlle

GLAVCVS

Tutorials

Forums

Activity