Ok, here's my text centering routine that I have had around for years with this integrated into it, so this routine will do all of the following:
- Center text between two horizontal points (when this is done, the .y of the text will not change)
- Center text between two vertical points (when this is done, the .x of the text will not change)
- Center text between to diagonal points
- Align the selected pieces of text with another piece of text (the .y of each piece of text will not change)
- Center the text in "cells" of a table drawn with lines
The remarks specify how you get the routine to accomplish what:
;*************************************************************************************************************************
;| ATM.LSP **
**
VERSION 4.0 **
BY: Chris Wade **
12-14-09 **
**
- Added the ability to center text within cells automatically. **
- Code to center text adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0 **
- Changed if statements to cond where it would speed up the program. **
- Adjusted error code for the centering the text option. **
**
VERSION 3.1 **
BY: Chris Wade **
12-03-09 **
**
- Modified code to not use the move command. **
- Removed uneeded variable modifications. **
- Streamlined Code. **
- Fixed a bug when aligning mixed text/mtext with text/mtext. **
- Removed being able to type to select the method to align. **
**
VERSION 3.02 **
BY: Chris Wade **
02-27-06 **
**
- Upgraded Error Handler (Uses less system resources as a result). **
- Removed unused code. **
**
VERSION 3.01 **
BY: Chris Wade **
04-11-05 **
**
- Options are now based on points picked and require no extra user input. **
- Bugs fixed. **
**
**
VERSION 3.0 **
BY: Chris Wade **
04-04-05 **
**
- "Realign" option now changes justification based on the text that is being aligned to. **
**
**
VERSION 2.3 **
BY: Chris Wade **
12-07-04 **
**
- Added the ability to select mtext. **
- Program now remembers the last selection used. **
**
**
VERSION 2.2 **
BY: Chris Wade **
12-06-04 **
**
- Made program customisable to set osnaps per user's preferences. **
- Now has no limit per drawing session. **
**
**
VERSION 2.1 **
BY: Chris Wade **
12-03-04 **
**
- Remembers OSNAPs and other variable that were previously set. **
**
**
VERSION 2.0 **
BY: Chris Wade **
12-02-04 **
**
- Added the option to select multiple items. **
- Code almost completely re-written. **
**
**
VERSION 1.0 **
BY: Chris Wade **
12-01-04 **
**
- Contains the following commands: **
ATM: Align To Middle **
- Aligns text to the middle of two points that the user selects, in the manner **
that the user specifies by selecting points. **
Options: **
- Click two points that are on the X axis from each other (i.e. Horizontal): **
- X align - Aligns text horizontally between the two points. **
- Adjusts text justification to Middle Center **
- Click two points that are on the Y axis from each other (i.e. Vertical): **
- Y align - Aligns text vertically between the two points **
- Adjusts text justification to Middle Left **
- Click two points that are not on the X or Y axis from each other (i.e. Diagonal): **
- XY align - Centers the text horizontally and vertically **
between two points. **
- Adjusts text justification to Middle Center **
- Click on a piece of text: **
- Text - Aligns to selected text. **
- Adjusts text justification to match the text that is aligned to. **
- Click on a blank spot: **
- Center - Centers text to cells in a table, will error out if no table lines are found. **
- Adjusts text justification to Middle Center **
|;;**
;*************************************************************************************************************************
(defun *error* (msg)
(if (and uflag doc) (vla-EndUndoMark doc))
(and ov (mapcar 'setvar vl ov))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw) (princ))
(DEFUN C:ATM ( / OO JJ xx CC CCC MM MM1 MM2 N1N RC C D x1 x2 y1 y2 FF NN JJ1 JJ2 FFF E ED EE GG HH RC uFlag)
(princ "\n\n ATM\nAllign to Middle\n Version 4.0\n\n")
(setq flt '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(-4 . "<AND")
(0 . "INSERT")
(66 . 1)
(-4 . "AND>")
(-4 . "OR>")
)
)
(vl-load-com)
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object)))
(setq CCC T)
(while CCC
(princ "\nPlease select the text that you wish to align: ")
(setq CCC (ssget flt))
(while (= CCC nil)
(princ "\nYou must select text! ")
(setq CCC (ssget flt))
)
(setq JJ (sslength CCC))
(setq C (getpoint "\nPlease select the first of the two points to determine the middle of (or....Pick a point on text to realign to/pick an empty space to center text in \"cells\"): "))
(setq CD (osnap C "_ins"))
(if (or (= CD nil) (= CD null) (= CD ""))
(setq CD (osnap C "_nea"))
)
(if (and (/= CD nil) (/= CD null) (/= CD ""))
(progn
(SETQ MM (entget (car (NENTSELP "" CD))))
(SETQ N1N (CDR (ASSOC 0 MM)))
(cond
( (= N1N "MTEXT")
(progn
(SETQ C (CDR (ASSOC 10 MM)))
(setq JJ1 (cdr (assoc 71 MM)))
(cond
((= JJ1 1)
(setq TAG "TL")
)
((= JJ1 2)
(setq TAG "TC")
)
((= JJ1 3)
(setq TAG "TR")
)
((= JJ1 4)
(setq TAG "ML")
)
((= JJ1 5)
(setq TAG "MC")
)
((= JJ1 6)
(setq TAG "MR")
)
((= JJ1 7)
(setq TAG "BL")
)
((= JJ1 8)
(setq TAG "BC"))
((= JJ1 9)
(setq TAG "BR")
)
)
)
)
((= N1N "TEXT")
(PROGN
(SETQ C (CDR (ASSOC 11 MM)))
(setq JJ2 (cdr (assoc 72 MM)))
(setq JJ3 (cdr (assoc 73 MM)))
(cond
((= JJ3 1)
(setq TAG "B")
)
((= JJ3 2)
(setq TAG "M")
)
((= JJ3 3)
(setq TAG "T")
)
)
(cond
((= JJ2 0)
(setq TAG (strcat TAG "L"))
)
((= JJ2 1)
(setq TAG (strcat TAG "C"))
)
((= JJ2 2)
(setq TAG (strcat TAG "R"))
)
)
)
)
)
(if (or (= N1N "MTEXT") (= N1N "TEXT"))
(PROGN
(setq D C)
(SETQ xx "X")
)
(progn
(setq D (getpoint "\nPlease select the second of the two points to determine the middle of: "))
(setq x1 (rtos (car C) 2 5))
(setq x2 (rtos (car D) 2 5))
(setq y1 (rtos (cadr C) 2 5))
(setq y2 (rtos (cadr D) 2 5))
(if (= y1 y2)
(progn
(setq xx "X")
(SETQ TAG "MC")
)
)
(if (= x1 x2)
(progn
(setq xx "Y")
(SETQ TAG "ML")
)
)
(if (and (/= x1 x2) (/= y1 y2))
(progn
(setq xx "NO")
(SETQ TAG "MC")
)
)
)
)
)
(progn
(setq xx "CENTER")
(setq TAG "MC")
)
)
(vla-StartUndoMark doc)
(setq uFlag t)
(TJUST12)
(setq FF 0)
(cond
((= xx "CENTER")
(progn
;Code to center text adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0
(vl-load-com)
(setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))
(mapcar 'setvar vl '(0 0))
(setq i -1)
(while (setq ent (ssname CCC (setq i (1+ i))))
(setq obj (vlax-ename->vla-object ent))
(if (eq "AcDbText" (vla-get-ObjectName obj))
(if (eq AcAlignmentLeft (vla-get-Alignment obj))
(progn
(setq tmp (vla-get-InsertionPoint obj))
(vla-put-Alignment obj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint obj tmp))
(vla-put-Alignment obj acAlignmentMiddleCenter))
(vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter))
(setq pt (vlax-get obj
(setq prop
(if (eq "TEXT" (cdr (assoc 0 (entget ent))))
'TextAlignmentPoint 'InsertionPoint))))
(setq eLst (entlast))
(vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")
(if (not (eq eLst (setq poly (entlast))))
(progn
(vla-getBoundingBox (vlax-ename->vla-object poly) 'MiP 'MaP)
(setq pLst (mapcar 'vlax-safearray->list (list mIP maP)))
(vlax-put-property obj prop
(vlax-3D-point
(polar (car pLst) (apply 'angle pLst) (/ (apply 'distance pLst) 2.))))
(entdel poly))
)
(princ "\n ** Boundary not Found ** "))
)
(mapcar 'setvar vl ov)
)
)
((= xx "X")
(progn
(while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
(PROGN
(setq HH (cdr (assoc 11 EE)))
(setq EE (subst (cons 11 (list (car (mid-pt C D)) (cadr HH) (caddr HH))) (assoc 11 EE) EE))
(entmod EE)
)
(PROGN
(setq GG (cdr (assoc 10 EE)))
(setq EE (subst (cons 10 (list (car (mid-pt C D)) (cadr GG) (caddr GG))) (assoc 10 EE) EE))
(entmod EE)
)
)
(setq FF (+ FF 1))
)
)
)
((= xx "Y")
(progn
(while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
(PROGN
(setq HH (cdr (assoc 11 EE)))
(setq EE (subst (cons 11 (list (car HH) (cadr (mid-pt C D)) (caddr HH))) (assoc 11 EE) EE))
(entmod EE)
)
)
(IF (= "MTEXT" II)
(PROGN
(setq GG (cdr (assoc 10 EE)))
(setq EE (subst (cons 10 (list (car GG) (cadr (mid-pt C D)) (caddr GG))) (assoc 10 EE) EE))
(entmod EE)
)
)
(setq FF (+ FF 1))
)
)
)
((= xx "NO")
(progn
(while (< FF JJ)
(setq EE (entget (ssname CCC FF)))
(setq II (cdr (assoc 0 EE)))
(IF (/= "MTEXT" II)
(PROGN
(setq EE (subst (cons 11 (list (car (MID-PT C D)) (cadr (mid-pt C D)) (caddr (MID-PT C D)))) (assoc 11 EE) EE))
(entmod EE)
)
)
(IF (= "MTEXT" II)
(PROGN
(setq EE (subst (cons 10 (list (car (MID-PT C D)) (cadr (mid-pt C D)) (caddr (MID-PT C D)))) (assoc 10 EE) EE))
(entmod EE)
)
)
(setq FF (+ FF 1))
)
)
)
)
(vla-EndUndoMark doc)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Justifies text - Adapted from Express Tools
(defun tjust12 ()
(setq flag TAG)
(acet-tjust CCC flag)
);defun c:tjust
;; Returns the middle of two points
(defun mid-pt (p1 p2)
(polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) )
)
Please note that as written this requires express tools to be installed, I had tried the justifytext command; however, it would present problems when I had to change the justification of more than 1000 pieces of text in one AutoCAD session, which happens a lot, if anyone has a better way to change the justification, I would love to get rid of the dependency on the express tools. I also tried to adapt this to not needing express tools before using code in one of the other thread without success.