Center Text Between Two Points

April 7, 2016

Searching fo a convenient way to center multiple lines of text, I came across this program by Lee Mac.

It works very well, and I'll admit to getting a big grin on my face while testing it, but found if the USC was shifted, the selected text would scoot away and center up somewhere unwanted.

Now, where I work is all boring 2D drawings, but they can be quite long in the X direction, hence the UCS shifting.

Going back to the original thread, I discovered Lee's disclaimer which I had overlooked before, was quite accurate:

"Assumes WCS (not tested/designed for all UCS/View settings)"

How difficult would it be to make this the ultimate text centering program by redesigning it "for all UCS/View settings"?

I tried to figure how to incorporate the trans function, but found myself overwhelmed both by this program's construction and my inability to find a trans function tutorial that explained it at the sandbox level in big block letters.

So to end the frustration, I ask the advice of those who know.

Thanks in advance,

Steve

;; By Lee Mac 04FEB2015
;; cadtutor.net/forum/showthread.php?90741
;; Post #7
;;
;; Center Text in Polyline  -  Lee Mac
;;
;; Added modifications suggested by Lee Mac 06OCT2015 to center TEXT/MTEXT between two points.
;; cadtutor.net/forum/showthread.php?90741
;; Post #13
;;
;; Oh yeah! Much more versatile now.
;;
;; Center Text Between 2 Points  -  Lee Mac
;;
;;=====================================================================
;;
;;    Assumes all text in the selection has the same rotation.
;;    Assumes WCS (not tested/designed for all UCS/View settings)
;;
;;=====================================================================
;;
;; Changed slightly to allow TEXT selection only: MTEXT not permitted,
;;
;;



(defun c:TXTC ( / f i l m n p r s x )
   (if
       (and
           (setq s (LM:ssget "\nSelect text: " '("_:L" ((0 . "TEXT")))))
           (setq p (getpoint "\nSpecify 1st point: "))
           (setq q (getpoint "\nSpecify 2nd point: " p))
       )
       (progn
           (setq r (cdr (assoc 50 (entget (ssname s 0))))
                 m (list (list (cos r) (sin r) 0) (list (- (sin r)) (cos r) 0) '(0 0 1))
                 n (list (list (cos r) (- (sin r)) 0) (list (sin r) (cos r) 0) '(0 0 1))
           )
           (repeat (setq i (sslength s))
               (setq l
                   (append l
                       (mapcar '(lambda ( x ) (mxv m x))
                           (text-box (entget (ssname s (setq i (1- i)))))
                       )
                   )
               )
           )
           (vl-cmdf "_.move" s "" "_non"
               (mxv n
                   (
                       (setq f
                           (lambda ( l )
                               (apply 'mapcar
                                   (cons '(lambda ( a b ) (/ (+ a b) 2.0))
                                       (mapcar '(lambda ( f ) (apply 'mapcar (cons f l))) '(min max))
                                   )
                               )
                           )
                       )
                       l
                   )
               )
               "_non"
               (f
                   (list p q)
               )
           )
       )
   )
   (princ)
)

;; The following function is based on code by gile

(defun text-box ( enx / bpt hgt jus lst ocs org rot wid )
   (cond
       (   (= "TEXT" (cdr (assoc 00 enx)))
           (setq bpt (cdr (assoc 10 enx))
                 rot (cdr (assoc 50 enx))
                 lst (textbox enx)
                 lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
           )
       )
       (   (= "MTEXT" (cdr (assoc 00 enx)))
           (setq ocs  (cdr (assoc 210 enx))
                 bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                 rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                 wid  (cdr (assoc 42 enx))
                 hgt  (cdr (assoc 43 enx))
                 jus  (cdr (assoc 71 enx))
                 org  (list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                            (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                      )
                 lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
           )
       )
   )
   (if lst
       (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
           (list
               (list (cos rot) (sin (- rot)) 0.0)
               (list (sin rot) (cos rot)     0.0)
              '(0.0 0.0 1.0)
           )
       )
   )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

Edited April 7, 2016 by StevJ
dang spellin errers

April 8, 2016

Lee has some info on "trans" but knowing Lee watch this space.

April 8, 2016

Please try the following modified code:

;; By Lee Mac 04FEB2015
;; cadtutor.net/forum/showthread.php?90741
;; Post #7
;;
;; Center Text in Polyline  -  Lee Mac
;;
;; Added modifications suggested by Lee Mac 06OCT2015 to center TEXT/MTEXT between two points.
;; cadtutor.net/forum/showthread.php?90741
;; Post #13
;;
;; Oh yeah! Much more versatile now.
;;
;; Center Text Between 2 Points  -  Lee Mac
;;
;;=====================================================================
;;
;;    Assumes all text in the selection has the same rotation.
;;    Assumes WCS (not tested/designed for all UCS/View settings)
;;
;;=====================================================================
;;
;; Changed slightly to allow TEXT selection only: MTEXT not permitted,
;;

(defun c:TXTC ( / f i l m n p r s x )
   (if
       (and
           (setq s (LM:ssget "\nSelect text: " '("_:L" ((0 . "TEXT")))))
           (setq p (getpoint "\nSpecify 1st point: "))
           (setq q (getpoint "\nSpecify 2nd point: " p))
       )
       (progn
           (setq r (cdr (assoc 50 (entget (ssname s 0))))
                 m (list (list (cos r) (sin r) 0) (list (- (sin r)) (cos r) 0) '(0 0 1))
                 n (list (list (cos r) (- (sin r)) 0) (list (sin r) (cos r) 0) '(0 0 1))
           )
           (repeat (setq i (sslength s))
               (setq l
                   (append l
                       (mapcar '(lambda ( x ) (mxv m x))
                           (text-box (entget (ssname s (setq i (1- i)))))
                       )
                   )
               )
           )
           (vl-cmdf "_.move" s "" "_non"
               (trans
                   (mxv n
                       (
                           (setq f
                               (lambda ( l )
                                   (apply 'mapcar
                                       (cons '(lambda ( a b ) (/ (+ a b) 2.0))
                                           (mapcar '(lambda ( f ) (apply 'mapcar (cons f l))) '(min max))
                                       )
                                   )
                               )
                           )
                           l
                       )
                   )
                   (ssname s 0) 1
               )
               "_non" (f (list p q))
           )
       )
   )
   (princ)
)

;; The following function is based on code by gile

(defun text-box ( enx / bpt hgt jus lst ocs org rot wid )
   (cond
       (   (= "TEXT" (cdr (assoc 00 enx)))
           (setq bpt (cdr (assoc 10 enx))
                 rot (cdr (assoc 50 enx))
                 lst (textbox enx)
                 lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
           )
       )
       (   (= "MTEXT" (cdr (assoc 00 enx)))
           (setq ocs  (cdr (assoc 210 enx))
                 bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                 rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                 wid  (cdr (assoc 42 enx))
                 hgt  (cdr (assoc 43 enx))
                 jus  (cdr (assoc 71 enx))
                 org  (list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                            (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                      )
                 lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
           )
       )
   )
   (if lst
       (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
           (list
               (list (cos rot) (sin (- rot)) 0.0)
               (list (sin rot) (cos rot)     0.0)
              '(0.0 0.0 1.0)
           )
       )
   )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

Thank you for retaining links to the original posts & comments, I appreciate it.

April 8, 2016

hi

this my trial,

(defun demo (/ e m)
 (if (setq e (entget (car (entsel "select test entity"))))
   (progn
     (setq
m (cons  (getpoint "click p1") m)
       m (cons  (getpoint "click p2") m)
m (mapcar '(lambda (a b) (/ (+ a b) 2)) (car m)(cadr m))

	   
     )
     (entmod (subst
	(cons 10 (list (car m)(cadr m) '0))
	(assoc 10 e)
	e
      )

     )

    
   )
 )
)

thanks

Edited April 8, 2016 by samifox

April 9, 2016

Please try the following modified code:

;; By Lee Mac 04FEB2015
;; cadtutor.net/forum/showthread.php?90741
;; Post #7
;;
;; Center Text in Polyline  -  Lee Mac
;;
;; Added modifications suggested by Lee Mac 06OCT2015 to center TEXT/MTEXT between two points.
;; cadtutor.net/forum/showthread.php?90741
;; Post #13
;;
;; Oh yeah! Much more versatile now.
;;
;; Center Text Between 2 Points  -  Lee Mac
;;
;;=====================================================================
;;
;;    Assumes all text in the selection has the same rotation.
;;    Assumes WCS (not tested/designed for all UCS/View settings)
;;
;;=====================================================================
;;
;; Changed slightly to allow TEXT selection only: MTEXT not permitted,
;;

(defun c:TXTC ( / f i l m n p r s x )
   (if
       (and
           (setq s (LM:ssget "\nSelect text: " '("_:L" ((0 . "TEXT")))))
           (setq p (getpoint "\nSpecify 1st point: "))
           (setq q (getpoint "\nSpecify 2nd point: " p))
       )
       (progn
           (setq r (cdr (assoc 50 (entget (ssname s 0))))
                 m (list (list (cos r) (sin r) 0) (list (- (sin r)) (cos r) 0) '(0 0 1))
                 n (list (list (cos r) (- (sin r)) 0) (list (sin r) (cos r) 0) '(0 0 1))
           )
           (repeat (setq i (sslength s))
               (setq l
                   (append l
                       (mapcar '(lambda ( x ) (mxv m x))
                           (text-box (entget (ssname s (setq i (1- i)))))
                       )
                   )
               )
           )
           (vl-cmdf "_.move" s "" "_non"
               (trans
                   (mxv n
                       (
                           (setq f
                               (lambda ( l )
                                   (apply 'mapcar
                                       (cons '(lambda ( a b ) (/ (+ a b) 2.0))
                                           (mapcar '(lambda ( f ) (apply 'mapcar (cons f l))) '(min max))
                                       )
                                   )
                               )
                           )
                           l
                       )
                   )
                   (ssname s 0) 1
               )
               "_non" (f (list p q))
           )
       )
   )
   (princ)
)

;; The following function is based on code by gile

(defun text-box ( enx / bpt hgt jus lst ocs org rot wid )
   (cond
       (   (= "TEXT" (cdr (assoc 00 enx)))
           (setq bpt (cdr (assoc 10 enx))
                 rot (cdr (assoc 50 enx))
                 lst (textbox enx)
                 lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
           )
       )
       (   (= "MTEXT" (cdr (assoc 00 enx)))
           (setq ocs  (cdr (assoc 210 enx))
                 bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                 rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                 wid  (cdr (assoc 42 enx))
                 hgt  (cdr (assoc 43 enx))
                 jus  (cdr (assoc 71 enx))
                 org  (list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                            (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                      )
                 lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
           )
       )
   )
   (if lst
       (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
           (list
               (list (cos rot) (sin (- rot)) 0.0)
               (list (sin rot) (cos rot)     0.0)
              '(0.0 0.0 1.0)
           )
       )
   )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

Thank you for retaining links to the original posts & comments, I appreciate it.

I keep program author and link to its location within the program header out of respect for the author's programming time and effort, and I occasionally revisit the program development thread for helpful hints and ideas.

Also, I consider it bad form to claim something not of my own making.

Thank you, Lee, for this supremely useful program update.

Tested it all day today, and it never disappointed.

It works perfectly.

Steve

April 10, 2016

Excellent to hear Steve, I'm delighted that you find the program useful.

March 29

Command: txtc ; error: no function definition: LM:SSGET

It's giving me the above error message.

March 29

lm:ssget is in the code above, so it should work if you load it in

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

March 29

7 hours ago, NKK said:

Command: txtc

Specify 1st point:
Specify 2nd point: ; error: invalid argument type: listp

April 1

On 3/29/2024 at 12:31 PM, Nikon said:

Specify 1st point:
Specify 2nd point: ; error: invalid argument type: listp

I think that this:

(setq q (getpoint "\nSpecify 2nd point: " p))

Should actually be this:

(setq q (getpoint p "\nSpecify 2nd point: "))

April 1

Both are valid (in AutoCAD at least).

Edited April 1 by Lee Mac

April 1

42 minutes ago, Lee Mac said:

Both are valid (in AutoCAD at least).

@Lee Mac Cool - wasn't aware of that, I guess just because I never tried to deviate from the way it's presented.

Well - if that is not the problem, then @Nikon must be using another CAD system that needs the argument order to be correct? Or maybe the code was altered in some way?

April 1

49 minutes ago, Lee Mac said:

Both are valid (in AutoCAD at least).

I'm trying two options, the code doesn't work, but now there's a new error:

Command: TXTC
Select text:
Specify 1st point:
Specify 2nd point: ; error: no function definition: TEXT-BOX

Tested in AutoCAD 2015 rus...

April 1

6 minutes ago, Nikon said:

I'm trying two options, the code doesn't work, but now there's a new error:

Command: TXTC
Select text:
Specify 1st point:
Specify 2nd point: ; error: no function definition: TEXT-BOX

Tested in AutoCAD 2015 rus...

@NikonYou haven't shared what code changes you made, so how are we supposed to determine what the problem is? Without seeing your code, the error you are showing now is that there is no defined function called "text-box". were you trying to use the (textbox) function?

The AutoCAD help system is a fairly good resource for determining the proper syntax of AutoLISP functions. You should give it a try.

April 1

On 4/8/2016 at 2:18 PM, Lee Mac said:

(defun c: TXTC ( / f i l m n p r s x )
 (if
 (and
 (setq s (LM:ssget "\nSelect text: " '("_:L" ((0 . "TEXT")))))
 (setq p (getpoint "\nSpecify 1st point: "))
 (setq q (getpoint "\nSpecify 2nd point: " p))
 )
 (progn
 (setq r (cdr (assoc 50 (entget (ssname s 0))))
 m (list (list (cos r) (sin r) 0) (list (- (sin r)) (cos r) 0) '(0 0 1))
 n (list (list (cos r) (- (sin r)) 0) (list (sin r) (cos r) 0) '(0 0 1))
 )
 (repeat (setq i (sslength s))
 (setq l
 (append l
 (mapcar '(lambda ( x ) (mxv m x))
 (text-box (entget (ssname s (setq i (1- i)))))
 )
 )
 )
 )
 (vl-cmdf "_.move" s "" "_non"
 (trans
 (mxv n
 (
 (setq f
 (lambda ( l )
 (apply 'mapcar
 (cons '(lambda ( a b ) (/ (+ a b) 2.0))
 (mapcar '(lambda ( f ) (apply 'mapcar (cons f l))) '(min max))
 )
 )
 )
 )
 l
 )
 )
 (ssname s 0) 1
 )
 "_non" (f (list p q))
 )
 )
 )
 (princ)
)

;; The following function is based on code by gile

(defun text-box ( enx / bpt hgt jus lst ocs org rot wid )
 (cond
 ( (= "TEXT" (cdr (assoc 00 enx)))
 (setq bpt (cdr (assoc 10 enx))
 rot (cdr (assoc 50 enx))
 lst (textbox enx)
 lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
 )
 )
 ( (= "MTEXT" (cdr (assoc 00 enx)))
 (setq ocs (cdr (assoc 210 enx))
 bpt (trans (cdr (assoc 10 enx)) 0 ocs)
 rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
 wid (cdr (assoc 42 enx))
 hgt (cdr (assoc 43 enx))
 jus (cdr (assoc 71 enx))
 org (list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0))
 (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
 )
 lst (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
 )
 )
 )
 (if lst
 ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
 (list
 (list (cos rot) (sin (- rot)) 0.0)
 (list (sin rot) (cos rot) 0.0)
 '(0.0 0.0 1.0)
 )
 )
 )
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
 (princ msg)
 (setvar 'nomutt 1)
 (setq sel (vl-catch-all-apply 'ssget arg))
 (setvar 'nomutt 0)
 (if (not (vl-catch-all-error-p sel)) sel)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

I'm trying this code

April 1

try this. It is a bit old, could be written more succinctly but generally works for me for most things:

command txt2rect or txt2circ (you guess what they both do.... rect will also do 2 user selected points)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:txt2rect ( / ptc centretext)
  (setq ptc (rectcentre))
  (txt2centre ptc)
)
(defun c:txt2circ ( / ptc)
  (setq ptc (circcentre))
  (txt2centre ptc)
)

(defun txt2centre ( ptc / txtset alignment myrotation Edata ptx pty mycons NewInsData NewData entlist entwidth newwidth elist sel endloop enttype txt)


  ;; From Box Text LISP
  ;; Text Box  -  gile / Lee Mac
  ;; Returns an OCS point list describing a rectangular frame surrounding
  ;; the supplied text or mtext entity with optional offset
  ;; enx - [lst] Text or MText DXF data list
  ;; off - [rea] offset (may be zero)
  (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (= "TEXT" (cdr (assoc 00 enx)))
            (setq bpt (cdr (assoc 10 enx))
                  rot (cdr (assoc 50 enx))
                  lst (textbox enx)
                  lst
                (list
                    (list (- (caar  lst) off) (- (cadar  lst) off)) (list (+ (caadr lst) off) (- (cadar  lst) off))
                    (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar  lst) off) (+ (cadadr lst) off))
                )
            )
        )
        (   (= "MTEXT" (cdr (assoc 00 enx)))
            (setq ocs  (cdr (assoc 210 enx))
                  bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                  rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                  wid  (cdr (assoc 42 enx))
                  hgt  (cdr (assoc 43 enx))
                  jus  (cdr (assoc 71 enx))
                  org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                             (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                       )
                  lst
                (list
                    (list (- (car org) off)     (- (cadr org) off))     (list (+ (car org) wid off) (- (cadr org) off))
                    (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off)     (+ (cadr org) hgt off))
                )
            )
        )
    )
    (if lst
        (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
            (list
                (list (cos rot) (sin (- rot)) 0.0)
                (list (sin rot) (cos rot)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
  )


  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdrawing)

  (princ "\nSelect Text")
  (while (and (/= enttype "TEXT")(/= enttype "MTEXT")(/= enttype "ATTDEF"))
    (setq txt (car (entsel "")))
    (setq Edata (entget txt))
    (setq enttype (cdr (assoc 0 Edata)))
  )
  (setq txtset (ssadd))
  (setq txtset (ssadd txt txtset))

;  (setq txtset (ssget '((0 . "*TEXT"))))
;  (setq Edata (entget (ssname txtset 0)))

  (setq myrotation (cdr (assoc 50 Edata)))
  (setq Newdata (subst (cons 50 0) (assoc 50 Edata) Edata) )
  (entmod Newdata)

  (setq alignment (gettextalign txtset))
;;  (setq ali (nth 0 (assoc 73 Edata)))
  (setq ptx (nth 0 (assoc 10 Edata)))
  (setq pty (nth 1 (assoc 10 Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)

  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq NewInsData (cons mycons ptc) )
  (setq Newdata (subst NewInsdata (assoc mycons Edata) Edata) )

  (if (= "TEXT" (cdr (assoc 0 Edata)))
    (progn
      (setq Newdata (subst (cons 50 myrotation)(assoc 50 Newdata) Newdata))
;;      (setq Newdata (subst (cons 73 ali)(assoc 73 Newdata) Newdata))
      (entmod Newdata)

    )
  )

  (if (= "ATTDEF" (cdr (assoc 0 Edata)))
    (progn
      (entmod Newdata)
    )
  )

  (if (= "MTEXT" (cdr (assoc 0 Edata))) ;;mtext etc.
    (progn
      (setq entlist Edata) ;;could be Edata
      (setq entwidth entlist)
      (setq newwidth (cdr (assoc 42 entlist))) ;;text line width assoc 41 for mtext 'box' width
      (if (< newwidth (cdr (assoc 42 entwidth)))(setq newwidth (+ MWidth newwidth)))
      (if (= (cdr (assoc 41 entlist)) 0)(setq newwidth 0)) ;;fix for zero width mtexts

;;(setq MTextCoords (text-box-off MyEntGet 1))
;;(setq MTextWidth (Distance (car MTextCoords) (cadr MTextCoords)))
;;(setq MyEntGet (subst (cons 41 MTextWidth) (assoc 41 MyEntGet) MyEntGet))


      (setq elist (subst (cons 41 newwidth)(assoc 41 Edata) Edata)) ;;if txt this is width factor, mtext its text width
      (setq elist (subst (cons mycons ptc)(assoc mycons elist) elist))
      (setq elist (subst (cons 50 myrotation)(assoc 50 elist) elist))

      (entmod elist)
    )
  )

  (command "_.justifytext" txtset "" alignment)

  (vla-endundomark thisdrawing)
  (princ)
)

(defun rectcentre ( / pt1 pt2 ptx pty ptz ptc)
  (setq pt1 (getpoint "\nPick Corner 1"))
;;  (setq myent (car (nentselp pt1)))
;;  (princ (cdr (assoc 0 (entget myent)))) ;; how to check if a circle or closed polyline selected
  (setq pt2 (getpoint "\nPick Corner 2"))
  (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) )
  (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) )
  (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) )
  (setq ptc (list ptx pty ptz))
  ptc
)
(defun circcentre ( / circ ent ptc enttype)
  (princ "\nSelect Circle")
  (while (/= enttype "CIRCLE")
    (setq circ (car (entsel "")))
    (setq ent (entget circ))
    (setq enttype (cdr (assoc 0 ent)))
  )
;  (setq circ (ssget '((0 . "CIRCLE"))))
;  (setq ent (entget (ssname circ 0)))
  (setq ptc (assoc 10 ent))
  (setq ptc (list (nth 1 ptc)(nth 2 ptc)(nth 3 ptc)))
  ptc
)




;;;;get centre point of text
(defun LM:txtcentre ( / b e centretext)
    (cond
        (   (not (setq e (car (nentsel)))))
        (   (not (setq b (LM:textbox (entget e))))
            (princ "\nInvalid object selected - please select text, mtext or attribute.")
        )
        (   (entmake
                (list
                   '(000 . "POINT")
                    (cons  010 (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0))
                    (assoc 210 (entget e))
                )
            )
        )
        (   (princ "\nUnable to create central point."))
    )
    (setq centretext (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0) )
  (list centretext e)
)
;; Text Box  -  Lee Mac (based on code by gile)
;; Returns the bounding box of a text, mtext, or attribute entity (in OCS)
(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)
;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)













(defun gettextalign ( txtset / txtset Edata ptx_old pty_old pty_new ptx_new mycons)

;;  (setq txtset (ssget '((0 . "*TEXT"))))
  (setq Edata (entget (ssname txtset 0)))
  (setq mycons 10)
  (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11))

  (setq ptx_old (nth 1 (assoc mycons Edata)))
  (setq pty_old (nth 2 (assoc mycons Edata)))

  (command "_.justifytext" txtset "" "MC")
  (setq Edata (entget (ssname txtset 0)))
  (setq ptx_new (nth 1 (assoc mycons Edata)))
  (setq pty_new (nth 2 (assoc mycons Edata)))

  (if (< ptx_old ptx_new)(setq alignx "L"))
  (if (> ptx_old ptx_new)(setq alignx "R"))
  (if (= ptx_old ptx_new)(setq alignx "C"))

  (if (> pty_old pty_new)(setq aligny "T"))
  (if (< pty_old pty_new)(setq aligny "B"))
  (if (= pty_old pty_new)(setq aligny "M"))


  (setq xyalign (strcat aligny alignx))
  (command "_.justifytext" txtset "" xyalign)

  xyalign
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Center Text Between Two Points

Recommended Posts

StevJ

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

StevJ

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

NKK

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

pkenewell

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

pkenewell

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

pkenewell

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity