Move the mtext to the center of the Closed polyline

[Prashanthr]

Hello Everyone,

I have mtext placed inside the closed polyline and want to move the mtext to the geometric center of the closed polyline. I tried to search for the lisp but couldn't find one. Can anyone please help me with a lisp which can do this?

[pbejse]

---

@Prashanthr wrote:

I have mtext placed inside the closed polyline and want to move the mtext to the geometric center of the closed polyline.

Here you go

(defun c:MTC ( / PLC MTColl PLColl i e a  PlDist NearestTo ent) ;; MoveToCenter
;;;	pBe Nove 2020 | Kent1Cooper	;;;
(defun PLC (pl / verts qua vertsum vertavg)
      (setq
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
        qua (length verts)
        vertsum (car verts)
      )
      (foreach vert (cdr verts) (setq vertsum (mapcar '+ vert vertsum)))
      (setq vertavg (mapcar '/ vertsum (list qua qua)))
      (append vertavg '(0.0))
    )
  
(if
  (setq ss (ssget "_:L"  '((-4 . "<OR")
			    (-4 . "<AND")
			    (0 . "LWPOLYLINE")  (90 . 4)
			    (-4 . "&=") (70 . 1) (-4 . "AND>")
			    (0 . "MTEXT")
			    (-4 . "OR>")
			  )))
	(progn
		(repeat (setq i (sslength ss))
		  	(setq e (ssname ss (setq i (1- i))))
		  		(if (eq "MTEXT" (Cdr (assoc 0 (setq ent (entget e)))))
				  	(setq MTColl (cons (list e (cdr (assoc 10 ent))) MTColl))
				  	(setq PLColl (cons e PLColl))
				  ))
	  	(while (And (setq a (car MTColl)) PLColl)
		  (setq PlDist (mapcar '(lambda (itm)
		  			(list (distance (vlax-curve-getclosestpointto itm (cadr a))
							(cadr a)) itm))
					   PLColl )
			)
		  (setq NearestTo (Car (vl-sort PlDist '(lambda (n m)(< (car n)(car m))))))
		  (setq ent (entget (car a)))
		  (entmod (subst (cons 10  (plc (Cadr NearestTo))) (assoc 10 ent) ent))
	  	  (setq MTColl (Cdr MTColl) PLColl (vl-remove (Cadr NearestTo) PLColl))
	  	)
	  )
  )
  (princ)
  )

HTH

[hak_vz]

(defun c:centertext ( / point2d sort_clockwise vectorSide sstxt ss i j k in te tent pt e eo cords sd x y tn );

(defun pt2d (ptlist / ret) (while ptlist (setq ret (cons (list (car ptlist)(cadr ptlist)) ret) ptlist (cddr ptlist))) ret)
(defun sort_clockwise (ptlist)
(setq p (list (/ (apply '+ (mapcar 'car ptlist)) (length ptlist))(/ (apply '+ (mapcar 'cadr ptlist)) (length ptlist))))
(vl-sort ptlist '(lambda (a b) (> (sin (- (angle p a) (angle p b))) -1e-14)))
)
(defun vectorSide (v1 v2 p / r *fuzz*)
(setq r (- (* (-(car v2)(car v1))(-(cadr p)(cadr v1)))
           (* (-(cadr v2)(cadr v1))(-(car p)(car v1)))
        )
	*fuzz* 1e-10
)
(cond ((equal r 0.0 *fuzz*) 0) (t (fix (/ (abs r) r))))
)
(princ "\nSelect text objects to be centeedr >")
(setq sstxt (ssget  '((0 . "*TEXT"))))
(princ "\nSelect closed polylines to center >")
(setq ss (ssget '((0 . "*POLYLINE"))))
(setq k 0 in nil)
(while (< k (sslength sstxt))
(setq te (ssname sstxt k))
(setq tent (entget te))
(setq pt (cdr (assoc 10 (entget te))) i 0)

(while (< i (sslength ss))
(setq e (ssname ss i))
(setq eo (vlax-ename->vla-object e))
(setq coords (sort_clockwise(pt2d(vlax-get eo 'Coordinates))) sd nil j -1)
(while (< (setq j (1+ j)) (-(length coords) 1))(setq p1 (nth j coords) p2 (nth (+ j 1) coords) sd (cons (vectorSide p1 p2 pt) sd)))
	(if (apply 'and (mapcar '(lambda (x) (= x -1)) sd))
		(progn
		(setq x (/ (apply '+(mapcar 'car coords)) (length coords)))
		(setq y (/ (apply '+(mapcar 'cadr coords)) (length coords)))
		(setq tn (list x y))
		(setq tent (subst (cons 10 tn)(assoc 10 tent) tent))
		(entmod tent)
		)
	)
(setq i (+ i 1))
)
(setq k (+ k 1))
)
(princ)
)

[Moshe-A]

@Prashanthr ,

check this one 😀

; Text to Center

(defun c:t2c (/ is_text_inside ; local function
                _Centrum ss0 ss1 ss2)

 (defun is_text_inside (p1 p2)
  (vl-some
    '(lambda (ent2 / elist2 p0)
      (setq elist2 (entget ent2))
      (setq p0 (cdr (assoc '10 elist2)))
      (if (and
           (<= (car  p1) (car  p0)) (>= (car  p2) (car  p0))
           (<= (cadr p1) (cadr p0)) (>= (cadr p2) (cadr p0))
          )
       ent2
      )
     ); lambda
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))
  ); vl-some
 ); is_text_inside
  
 (setq _Centrum (lambda (t1 t2) (mapcar '(lambda (x0 x1) (/ (+ x0 x1) 2) t1 t2))) 
   
 (if (setq ss0 (ssget '((-4 . "<or")
                       	 (-4 . "<and") (0 . "lwpolyline") (70 . 1) (-4 . "and>")
                         (0 . "text,mtext")
                        (-4 . "or>")
                       )
               )
     )
  (progn
   (setq ss1 (ssadd) ss2 (ssadd))
   (foreach ename0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0))) 
    (if (eq (cdr (assoc '0 (entget ename0))) "LWPOLYLINE")
     (ssadd ename0 ss1)
     (ssadd ename0 ss2)
    )
   ); foreach
   
   (mapcar
    '(lambda (ename1 / AcDbPline p1 p2 MinPoint MaxPoint ent2 elist2)
      (setq AcDbPline (vlax-ename->vla-object ename1))
      (vla-getBoundingBox AcDbPline 'MinPoint 'MaxPoint)
      (setq p1 (vlax-safearray->list MinPoint))
      (setq p2 (vlax-safearray->list MaxPoint))
     
      (if (setq ent2 (is_text_inside p1 p2))
       (progn
        (setq elist2 (entget ent2))
        (entmod (subst (cons '10 (_Centrum p1 p2)) (assoc '10 elist2) elist2))
       ); progn
      ); if
       
      (vlax-release-object AcDbPline)
     )
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
   ); mapcar
   
  ); progn
 ); if

 (princ)
); c:t2c

[pbejse]

(defun c:MTC ( / PLC MTColl PLColl i e a  PlDist NearestTo ent) ;; MoveToCenter
;;;	pBe Nove 2020 | Kent1Cooper	;;;
(defun PLC (pl / verts qua vertsum vertavg)
      (setq
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl)))
        qua (length verts)
        vertsum (car verts)
      )
      (foreach vert (cdr verts) (setq vertsum (mapcar '+ vert vertsum)))
      (setq vertavg (mapcar '/ vertsum (list qua qua)))
      (append vertavg '(0.0))
    )
  
(if
  (setq ss (ssget "_:L"  '((-4 . "<OR")
			    (-4 . "<AND")
			    (0 . "LWPOLYLINE")  (90 . 4)
			    (-4 . "&=") (70 . 1) (-4 . "AND>")
			    (0 . "MTEXT")
			    (-4 . "OR>")
			  )))
	(progn
		(repeat (setq i (sslength ss))
		  	(setq e (ssname ss (setq i (1- i))))
		  		(if (eq "MTEXT" (Cdr (assoc 0 (setq ent (entget e)))))
				  	(setq MTColl (cons (list e (cdr (assoc 10 ent))) MTColl))
				  	(setq PLColl (cons (plc e) PLColl))
				  ))
	  	(while (And (setq a (car MTColl)) PLColl)
		  (setq PlDist (mapcar '(lambda (itm)
		  			(list (distance itm
							(cadr a)) itm))
					   PLColl )
			)
		  
		  (setq NearestTo (Car (vl-sort PlDist '(lambda (n m)(< (car n)(car m))))))
		  (setq ent (entget (car a)))
		  (entmod (subst (cons 10  (Cadr NearestTo)) (assoc 10 ent) ent))
	  	  (setq MTColl (Cdr MTColl) PLColl (vl-remove NearestTo PLColl))
	  	)
	  )
  )
  (princ)
  )

This time its "Centroid" as reference instead of the LWPolyline entity 

[ronjonp]

Not that you need another solution but... 😂

(defun c:foo (/ _l c d r s s2 x)
  ;; RJP » 2020-11-13
  (defun _l (s) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
  (if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
	   (setq s2 (ssget "_X" '((0 . "*TEXT"))))
	   (setq s (_l s))
	   (setq s2 (mapcar '(lambda (x) (cons (cdr (assoc 10 (entget x))) x)) (_l s2)))
      )
    (foreach e s
      (vla-getboundingbox (vlax-ename->vla-object e) 'c 'd)
      (mapcar 'set '(c d) (mapcar 'vlax-safearray->list (list c d)))
      (if (setq	r
		 (cdr
		   (vl-some '(lambda (x)
			       (if (and (<= (car c) (caar x) (car d)) (<= (cadr c) (cadar x) (cadr d)))
				 x
			       )
			     )
			    s2
		   )
		 )
	  )
	(entmod (append (entget r) (list (cons 10 (polar c (angle c d) (* 0.5 (distance c d)))))))
      )
    )
  )
  (princ)
)

[john.uhden]

This is all too simple with rectangular polylines as you have illustrated.

Thankfully, you have received help from some of the best people here.  Give them all the credit they deserve.

Now if your polylines were shaped like amoebas or ink blots, the question of center becomes more complex and debatable, especially if the text were too wide for the width at any point.  I remember trying to figure out where to place the text for SSURGO polyline soil types imported via AutoCAD Map.  It tuned into a trial and error cluster gathering until I just said, "Okay, that's good enough!"  I haven't had the reason to use it in years, but I'm pretty sure I would still find fault with it.

[john.uhden]

@Prashanthr :

It was there.  I just found it for you...

(defun @group (old n / item new)
  (while old
    (while (< (length item) n)
      (setq item (cons (car old) item) old (cdr old))
    )
    (setq new (cons (reverse item) new) item nil)
  )
  (reverse new)
)

which can be used as follows:

Command: (setq coords '(1 2 3 4 5 6 7 8 9)
Command: (@group coords 3)
((1 2 3) (4 5 6) (7 8 9))

or

Command: (setq coords '(1 2 3 4 5 6 7 8)
Command: (@group coords 2)
((1 2)(3 4)(5 6)(7 8))

[Kent1Cooper]

So now that there are several approaches suggested but none accepted as a Solution, clarify some things for us....

Some of them look for only Mtext [supported by your original description], and some for both Text and Mtext.  Might the text objects sometimes be plain Text?  If so, the (assoc 10) code some extract for the insertion point may not be the right thing to position it by, depending on the justification [good for Left justification -- otherwise you want (assoc 11)].

Whether Text or Mtext, are they always of the same justification?  Which one?  If always Middle or Middle Center, positioning by the insertion should do what you want, but otherwise the middle-of-bounding-box approach would be better.

Some of them ask the User to select things, and some look for things from the whole drawing.  What is your anticipated User procedure?

Some look for only closed  Polylines, but some allow open ones.  And some restrict them to 4 vertices only, but some allow any number.  If they're really always and only closed 4-vertex rectangular ones, it's not necessary to either average all their vertex locations or convert them to VLA objects to get their bounding boxes -- you could simply find the midpoint between their first and third [or second and fourth] vertices.

Some specificity about the possible detailed circumstances, and about what you intend as the steps the User would take, would be helpful.

[Kent1Cooper]

---

@Moshe-A wrote:

....
                       	 (-4 . "<and") (0 . "lwpolyline") (70 . 1) (-4 . "and>")
....

---

Something to be careful about....

That may not find all closed LWPolylines as intended.  The 70 entry contains the 1 bit if the Polyline is closed, but it can also contain the 128 bit if linetype generation is enabled for that Polyline.  So that will miss any of them that are closed but have linetype generation enabled, because the entry will be  (70 . 129).  The way to find both kinds [all closed ones, regardless of linetype generation] is @pbejse 's combination:

(-4 . "&=") (70 . 1)

which finds anything containing the 1 bit in that 70 entry, whether or not other bits are included in the value.

[ronjonp]

In my opinion there is no reason to filter for closed polylines if using the BB method or averaging the  vertex list. Sure these methods can be fooled and text that is 'within' will be placed outside. It's hard to account for all scenarios to solve .. especially at this price point. 🍻

[john.uhden]

Perhaps a better solution would be the MOVE command accompanied by
decent eyesight and manual dexterity.

[Kent1Cooper]

---

@ronjonp wrote:

In my opinion there is no reason to filter for closed polylines ....

---

Given the original image, I agree.  But it depends on how representative that is.  They might want to be able to, for example, grab a large area in a window or crossing selection, which in a real situation might include other Polylines that they don't want selected.  So if they're looking for rectangles that were made with the RECTANG command, filtering for only closed ones with 4 and only 4 vertices would see all the ones they want, but ignore others [at least most others -- there could be unwanted ones with at least those two properties].  This is the kind of reason that I raise questions such as those in Message 9.

[ronjonp]

@Kent1Cooper That is a very detailed query for the OP and this forum is very lucky to have someone like you. I like to solve code problems but many times the bigger problem originates with people not knowing how to ask smart questions. I know this is not always the case .. we have language barriers to overcome as well. Lets see if you get some feedback! 🍻

[Sea-Haven]

My $0.05 the posters here have provided impressive answers, my money is on the ones use boundingbox so text or mtetx does not matter, only reason I comment is had to do same thing for a block centre to move it and found using UCS ob on rotated block worked much better,  but have to do trans as well on the pt. A rotated text will possibly return the mid point at any angle but thought I would mention it. We all know "Its not working quite right"

[Kent1Cooper]

---

@Sea-Haven wrote:

.... my money is on the ones use boundingbox so text or mtetx does not matter....

---

And also because the justification doesn't matter.  But the possible drawback with Mtext is that the width of an Mtext object's bounding box is the width of its defining box, regardless of its content.  If the content is a lot less wide, or if a single word is too long and overshoots that defining-box width, the bounding box won't reflect the visible content, so centering based on that won't look centered.  Here, the green are the bounding boxes:

[pbejse]

Now only if the OP would care to reply ....

There's always something .. 😊

[mik501_]

hi. It works only with mtext, how to make it work with text?