Here is my version, which does what is being asked for and a bit more.
Please note that this is a routine that we have had in place for a while, but I rewrote a good portion of it yesterday to speed it up and remove some bugs, it has not been 100% tested yet, so there may still be some more bugs in it. Also, any suggestions for improvements are more than welcome. I believe I have commented all borrowed code, if you recognize code that came from another routine, please let me know so that I can give the proper credit. Also, I use Notepad++ for my editing, so the formatting is designed to look the best in it.
Edit: I changed the code to being attached, as there were problems with how it pasted.
<edit: CAB added formatted code back>
;*************************************************************************************************************************
;| AT.LSP **
VERSION 6.0 **
BY: Chris Wade **
09-21-10 **
**
- Mostly rewritten **
- 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: **
- After selecting an object, press N for Notes. The note will be inserted next to the line **
that you selected and will be based on the layer that the text is on. **
- 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 c:AT (/ flt CCC A B C D E F G H TAG vl i ent obj tmp pt prop eLst pLst poly ov)
(setq flt '((-4 . "<OR")
(0 . "TEXT")
(0 . "MTEXT")
(-4 . "<AND")
(0 . "INSERT")
(66 . 1)
(-4 . "AND>")
(-4 . "OR>")
)
)
(setq CCC T)
(while CCC
(setq CCC (ssget flt))
(cond
((= CCC nil)
(princ "\nYou must select text to use!")
)
(T
(initget "N _Notes")
(setq C (getpoint "\nPick first point/<N>ote bubble: "))
(cond
((= C "Notes")
;Insert General or Reference Notes
(setq PickPt (last (last (last (ssnamex CCC)))))
(setq CopyText (entget (ssname CCC 0))) ;get entity information for mtext
(setq LS (cdr (assoc 73 CopyText))
LS2 (assoc 73 CopyText)
Lay (assoc 8 CopyText))
(if (= LS 1)
(progn
(setq CopyText (subst '(73 . 2) (assoc 73 CopyText) CopyText))
(entmod CopyText)
)
)
(setq InsPt (list (cadr(assoc 10 CopyText)) (caddr(assoc 10 CopyText)))) ;get mtext insertion point
(setq Theight (cdr (assoc 40 CopyText))) ;get mtext height
(setq Tspacing (cdr (assoc 44 CopyText))) ;get line spacing
(setq NoteNum "1")
(setq LineNumber 0)
(cond
((or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1))
(progn
(SETQ ScaleFactor (GETVAR "DIMSCALE"))
(SETQ DistanceLeft (/ ScaleFactor 4.8))
)
)
((and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(progn
(setq ScaleFactor 1)
(SETQ DistanceLeft (/ ScaleFactor 4.8))
)
)
)
(cond
((= (cdr Lay) "$GN")
(setvar "clayer" "$GN")
(NumberNow_AT "GN")
)
(T
(setvar "clayer" "$RN")
(NumberNow_AT "RN")
)
)
)
(T
(setq D (osnap C "_ins"))
(cond
((or (= D nil) (= D null))
(setq D (osnap C "_nea"))
)
(T
(SETQ A (entget (car (NENTSELP "" D))))
(SETQ B (CDR (ASSOC 0 A)))
(cond
((= B "ATTRIB")
(setq TAG "TL")
)
((= B "MTEXT")
(setq E (cdr (assoc 71 A)))
(setq G (cdr (assoc 10 A)))
(cond
((= E 1)
(setq TAG "TL")
)
((= E 2)
(setq TAG "TC")
)
((= E 3)
(setq TAG "TR")
)
((= E 4)
(setq TAG "ML")
)
((= E 5)
(setq TAG "MC")
)
((= E 6)
(setq TAG "MR")
)
((= E 7)
(setq TAG "BL")
)
((= E 8)
(setq TAG "BC"))
((= E 9)
(setq TAG "BR")
)
)
)
((= B "TEXT")
(setq E (cdr (assoc 72 A)))
(setq F (cdr (assoc 73 A)))
(setq G (cdr (assoc 11 A)))
(cond
((= F 1)
(setq TAG "B")
)
((= F 2)
(setq TAG "M")
)
((= F 3)
(setq TAG "T")
)
)
(cond
((= E 0)
(setq TAG (strcat TAG "L"))
)
((= E 1)
(setq TAG (strcat TAG "C"))
)
((= E 2)
(setq TAG (strcat TAG "R"))
)
)
)
)
;Insert code to align text.
(center "X" CCC G G TAG)
)
)
(cond
((or (= D nil) (= D null))
;Code to center text inside boxes adapted from Lee Mac's code at http://www.theswamp.org/index.php?topic=31289.0
(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" "_o" "_r" "_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)
)
(T
;Center text between two points
(setq H (getpoint "\nPlease select the second of the two points to determine the middle of: "))
(setq x1 (rtos (car C) 2 5)
x2 (rtos (car H) 2 5)
y1 (rtos (cadr C) 2 5)
y2 (rtos (cadr H) 2 5))
(cond
((= y1 y2)
(center "X" CCC C H "MC")
)
((= x1 x2)
(center "Y" CCC C H "ML")
)
(T
(center "NO" CCC C H "MC")
)
)
)
)
)
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun NumberNow_AT (xx)
(if (= LineNumber 0)
(progn
(setq PickDist(distance InsPt (list (car InsPt) (cadr PickPt)))) ;get distance from insertion point down to picked point
(setq LineNumber(fix (+ 1 (/ PickDist (* Tspacing (/ Theight 0.6)))))) ;number of lines down to selected line
)
)
(cond
((or (= xx "GN") (= xx "RN"))
(setq NoteNum (getstring "\nEnter Note Number: "))
)
)
(setq DistanceDown (* Tspacing (* (- LineNumber 1) (/ Theight 0.6)))) ;set distance down from mtext insertion point to insert note
(setq NewInsPt (list (- (car InsPt) DistanceLeft) (- (- (cadr InsPt) (/ Theight 2)) DistanceDown))) ;combine the two into one point
(princ "\nWorks to here!")
(cond
((or (= xx "GN") (= xx "ATG"))
(vl-cmdf "-insert" "GN" "X" ScaleFactor "Y" ScaleFactor NewInsPt "0" NoteNum)) ;insert note symbol (attributes have been set to not verify) - For general notes bubble
((or (= xx "RN") (= xx "ATR"))
(vl-cmdf "-insert" "RN" "X" ScaleFactor "Y" ScaleFactor NewInsPt "0" NoteNum)) ;insert note symbol (attributes have been set to not verify) - For general notes bubble
((= xx "AN")
(progn
(setq Bubble (ssget "_C" C C)
Bubble (ssname Bubble 0))
(setq CopyBubble (entget Bubble)); Entity information for bubble
(setq att (entget (car (nentselp "" (cdr (assoc 10 CopyBubble))))))
(setq CopyBubble (subst (cons 10 NewInsPt) (assoc 10 CopyBubble) CopyBubble))
(setq att (subst (cons 11 NewInsPt) (assoc 11 att) att))
(entmod att)
(entmod CopyBubble)
)
)
)
(cond
((/= xx "AN")
(setq NoteNumSave (+ (atof NoteNum) 1)) ;increment counter
(setq NoteNum (rtos NoteNumSave 5 0)) ;set format of number
)
)
)
; Justifies text - Adapted from Express Tools
(defun center (xx CCC H G TAG / GG TxtList)
(tjust12)
(setq TxtList (tmw:ss->Objlist CCC))
(foreach item TxtList
(setq GG (tmw:Var->Safe (vla-get-InsertionPoint item)))
(cond
((= xx "X")
(vla-put-InsertionPoint item (vlax-3d-point (list (car (mid-pt H G)) (cadr GG) (caddr GG))))
)
((= xx "Y")
(vla-put-InsertionPoint item (vlax-3d-point (list (car GG) (cadr (mid-pt H G)) (caddr GG))))
)
((= xx "NO")
(vla-put-InsertionPoint item (vlax-3d-point (list (car (MID-PT H G)) (cadr (mid-pt H G)) (caddr (MID-PT H G)))))
)
)
) ;_ foreach
)
(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.) )
)
(defun tmw:ss->Objlist (ss / RtnList temp1)
(while (setq temp1 (ssname ss 0))
(setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
(ssdel temp1 ss)
) ;_ while
RtnList
) ;_ defun
(defun tmw:Var->Safe (VariantValue /)
(if (= (type VariantValue) 'variant)
(safearray-value (variant-value VariantValue))
) ;_ if
) ;_ defun
(DEFUN DTR (X)
(/ (* X PI) 180.0)
)