Author Topic: [wip] Explode mtext function  (Read 19063 times)

0 Members and 1 Guest are viewing this topic.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: [wip] Explode mtext function
« Reply #30 on: July 16, 2009, 12:24:27 PM »
For those following along, I think this version one ups the command explode and mtext.  If you explode mtext that is isn't left justified, it will line up the text correctly, but will make the text left justified, but with my explode method, it will keep the justification either left, middle or right, so that it is truly lined up.  Just an FYI for those following along.  We now return you back to your regularly scheduled program.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: [wip] Explode mtext function
« Reply #31 on: July 16, 2009, 12:40:49 PM »
you are close Tim.

still you get this when using tabs on the mtx.-

T.Willey

  • Needs a day job
  • Posts: 5251
Re: [wip] Explode mtext function
« Reply #32 on: July 16, 2009, 01:55:12 PM »
I'll see what I can do about that Luis.

And Vovka, I will see what I can do about that also.  The fraction is the problem.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: [wip] Explode mtext function
« Reply #33 on: July 16, 2009, 06:20:22 PM »
Tim,
I'll probably just need to substitute spaced for the tabs before I do the mojo on the string from net.

.. homework for the weekend


also homework .. is there any way to determine the no. of characters shifted by a tab ????
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: [wip] Explode mtext function
« Reply #34 on: July 16, 2009, 06:22:37 PM »
Tim,
I'll probably just need to substitute spaced for the tabs before I do the mojo on the string from net.

.. homework for the weekend


also homework .. is there any way to determine the no. of characters shifted by a tab ????

Not that I know of ( was wondering the same thing ).  I'm not even sure where it would be located.  If it's an Acad thing, or a font/shx file thing.  Right now I just place four spaces per tab.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: [wip] Explode mtext function
« Reply #35 on: July 16, 2009, 09:14:26 PM »
I was able to do this:

Quote
*** Command: XMT
*** (ExplodeMText <ename>) Return T or Nil

Quote
Command: XMT
Select a mtext entity:

(ExplodeMText (car (entsel "\nSelect a mtext: ")))

Attached it is a debug objectARX file for AutoCAD 2007 to 2009

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: [wip] Explode mtext function
« Reply #36 on: July 17, 2009, 12:35:00 AM »

Luis,
Is there any special reason why you don't post your code ???

Regards,
Kerry
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: [wip] Explode mtext function
« Reply #37 on: July 17, 2009, 01:50:31 PM »
I was able to do this:

Quote
*** Command: XMT
*** (ExplodeMText <ename>) Return T or Nil

Quote
Command: XMT
Select a mtext entity:

(ExplodeMText (car (entsel "\nSelect a mtext: ")))

Attached it is a debug objectARX file for AutoCAD 2007 to 2009

Wow Luis!  It even worked great on that last one by Vovka.  But it only explodes the text to model space.  I tried it on an mtext object in paper space, but the text was inserted into model space, and put it on layer 0.  Still impressive though.  Dang ObjectARX.  :cry:
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: [wip] Explode mtext function
« Reply #38 on: July 17, 2009, 03:03:18 PM »
Wow Luis!  It even worked great on that last one by Vovka.  But it only explodes the text to model space.  I tried it on an mtext object in paper space, but the text was inserted into model space, and put it on layer 0.  Still impressive though.  Dang ObjectARX.  :cry:

It was just a quicky one... simple implementation of AcDbMTextFragment structure, was going to do these other properties like: italic and bold, underline, overline.... but it is to much :)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: [wip] Explode mtext function
« Reply #39 on: July 17, 2009, 03:18:16 PM »
Wow Luis!  It even worked great on that last one by Vovka.  But it only explodes the text to model space.  I tried it on an mtext object in paper space, but the text was inserted into model space, and put it on layer 0.  Still impressive though.  Dang ObjectARX.  :cry:

It was just a quicky one... simple implementation of AcDbMTextFragment structure, was going to do these other properties like: italic and bold, underline, overline.... but it is to much :)

Cool still though.   :-)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: [wip] Explode mtext function
« Reply #40 on: July 18, 2009, 01:15:03 PM »

Luis,
Is there any special reason why you don't post your code ???

Regards,
Kerry

Nothing special at all, I was able to work a little more on the project and it is now (the ObjectARX source) here:

http://www.theswamp.org/index.php?topic=29544.new#new

HTH
Luis.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: [wip] Explode mtext function
« Reply #41 on: July 18, 2009, 07:10:42 PM »

Thanks Luis,
that's more in line with the philosophy of the forum.   :-)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: [wip] Explode mtext function
« Reply #42 on: July 18, 2009, 08:38:56 PM »
Re the tabs and spaces,

The short answer is
"it depends .. "


Quote

(3 . "x using Arial \\Px\ttab\\Px    4 spaces\\P\\P{\\Fisocp|c0;
x using isocp\\Px\ttab\\Px    4 spaces\\P\\P\\fAndale Mono|b0|i0|c0|p49;
x using Andale Mono\\Px \ttab\\Px    4 spaces\\P\\P\\Fromans|c0;
x using romans\\Px \ttab\\Px    4 spaces\\P\\P\\fBitstream Vera Sans Mono|b0|i0|")(1 . "c0|p49;
x using Bitstream Vera Mono\\Px \ttab\\Px    4 spaces\\P\\P\\Ftxt|c0;x using txt\\Px \ttab\\Px    4 spaces}")

kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

GOTNONE

  • Guest
Re: [wip] Explode mtext function
« Reply #43 on: March 07, 2012, 05:56:24 PM »
First of all, thanks for the work on this code.  The ability to explode mtext inside of blocks is an extremely nice feature.  Unfortunately, I think there is a problem with how this program handles text with a width of 0.  When the dxf code 41 is 0, it seems to split the string incorrectly.  Here is an example:
Code: [Select]
(entmake
  '((0 . "MTEXT")
    (100 . "AcDbEntity")
    (67 . 0) (410 . "Model")
    (8 . "0")
    (100 . "AcDbMText")
    (10 0.0 0.0 0.0)
    (40 . 0.15625)
    (41 . 0.0)
    (46 . 0.0)
    (71 . 7)
    (72 . 1)
    (1
     .
     "\\fMyriad Roman|b0|i0|c0|p34;\\W1;realLy_longwordtestsTring"
    )
    (7 . "Standard")
    (210 0.0 0.0 1.0)
    (11 1.0 0.0 0.0)
    (42 . 0.550595)
    (43 . 0.15625)
    (50 . 0.0)
    (73 . 1)
    (44 . 1.0)
   )
)

_$ (EXPLODEMTEXT (vlax-ename->vla-object (ssname (ssget) 0)) (vla-get-activedocument (vlax-get-acad-object)))

"re"
"lLy_l"
"_longwor"
"ngwordtests"
"ordtestsTring"
"testsTring"
"tsTring"
"ring"
"g" (#<VLA-OBJECT IAcadText2 246ff0ac> #<VLA-OBJECT IAcadText2 2470892c> #<VLA-OBJECT IAcadText2 246fc82c> #<VLA-OBJECT IAcadText2 2470a02c> #<VLA-OBJECT IAcadText2 247065ac> #<VLA-OBJECT IAcadText2 246fc92c> #<VLA-OBJECT IAcadText2 246ff52c> #<VLA-OBJECT IAcadText2 2470592c> #<VLA-OBJECT IAcadText2 2470642c>)
_$


Strings containing spaces and having a dxf code 41 = 0 also are split incorrectly see:

Code: [Select]
(entmake
  '((0 . "MTEXT")
    (100 . "AcDbEntity")
    (67 . 0) (410 . "Model")
    (8 . "0")
    (100 . "AcDbMText")
    (10 0.0 0.0 0.0)
    (40 . 0.15625)
    (41 . 0.0)
    (46 . 0.0)
    (71 . 7)
    (72 . 1)
    (1
     .
     "\\fMyriad Roman|b0|i0|c0|p34;\\W1;test STring with spaces"
    )
    (7 . "Standard")
    (210 0.0 0.0 1.0)
    (11 1.0 0.0 0.0)
    (42 . 0.550595)
    (43 . 0.15625)
    (50 . 0.0)
    (73 . 1)
    (44 . 1.0)
   )
)

_$ (EXPLODEMTEXT (vlax-ename->vla-object (ssname (ssget) 0)) (vla-get-activedocument (vlax-get-acad-object)))

"test"
"STring "
"ing"
"with spaces"
"h"
"spaces"
"ces" (#<VLA-OBJECT IAcadText2 2470a7ac> #<VLA-OBJECT IAcadText2 246fffac> #<VLA-OBJECT IAcadText2 2470402c> #<VLA-OBJECT IAcadText2 247002ac> #<VLA-OBJECT IAcadText2 24701aac> #<VLA-OBJECT IAcadText2 247037ac> #<VLA-OBJECT IAcadText2 246fe4ac>)
_$


Thanks.

gotnone
« Last Edit: March 07, 2012, 06:00:10 PM by GOTNONE »

GOTNONE

  • Guest
Re: [wip] Explode mtext function
« Reply #44 on: March 15, 2012, 02:17:41 PM »
I made a change to fix the case for zero width mtext entities.  It seems to handle long strings with and without spaces correctly.  I am not sure that it didn't break other cases, but I offer it for others anyway.

Code: [Select]
(defun ExplodeMText ( mtObj doc / OwnerObj MtWd MtHt ll ur tempPt tempStr mtStr StPos tempNum StrsList SpList tempText tempList StyWd
    WdList WdCnt EndPos StrList TxStrList InsPt flag TxObjList SpCnt MtSty RemoveAllFormating FontLetterWidth PropsList MtLnSpc ExcptList )
    ;(ExplodeMtext (vlax-ename->vla-object (car (entsel))) (vla-get-ActiveDocument (vlax-get-Acad-Object)))
   
    (defun RemoveAllFormatting ( str / Pos nStr oChar LenStr BlsBktCnt ClsBktCnt ClnCnt cChar tempPos tempStr tempChar )
        ;(RemoveAllFormatting (vla-get-TextString (vlax-ename->vla-object (car (entsel)))))
       
        (setq Pos 1)
        (setq nStr "")
        (setq oChar "")
        (setq ClsBktCnt 0)
        (setq ClnCnt 0)
        (while (vl-string-search "\t" str)
            (setq str (vl-string-subst "    " "\t" str))
        )
        (setq LenStr (strlen str))
        (while (<= Pos LenStr)
            (setq cChar (substr str Pos 1))
            (cond
                (
                    (or
                        (and
                            (= cChar "{")
                            (/= (strcat oChar cChar) "\\{")
                        )
                        (and
                            (= cChar "}")
                            (/= (strcat oChar cChar) "\\}")
                        )
                    )
                )
                (
                    (and
                        (= cChar "\\")
                        (= oChar "\\")
                    )
                    (setq cChar "")
                )
                (
                    (and
                        (= cChar "\\")
                        (member (setq tempChar (substr str (1+ Pos) 1)) '("p" "a" "A" "c" "C" "f" "F" "h" "H" "q" "Q" "s" "S" "t" "T" "w" "W"))
                    )
                    (if (= (strcase tempChar) "S")
                        (progn
                            (setq tempPos (vl-string-search ";" str Pos))
                            (setq tempStr (substr str (+ 2 Pos) (1- (- tempPos Pos))))
                            (setq nStr
                                (strcat
                                    (if (= oChar " ")
                                        ""
                                        " "
                                    )
                                    (cond
                                        ((vl-string-search "#" tempStr)
                                            (vl-string-subst "/" "#" tempStr)
                                        )
                                        ((vl-string-search "^" tempStr)
                                            (vl-string-subst ", " "^" tempStr)
                                        )
                                        (t tempStr)
                                    )
                                    nStr
                                )
                            )
                            (setq Pos (1+ tempPos))
                            (setq cChar (substr str Pos 1))
                        )
                        (setq ClnCnt (1+ ClnCnt))
                    )
                )
                (
                    (and
                        (= cChar ";")
                        (not (zerop ClnCnt))
                    )
                    (setq ClnCnt (1- ClnCnt))
                )
                ((member (strcat cChar (substr str (1+ Pos) 1)) '("\\L" "\\l" "\\O" "\\o"))
                    (setq Pos (1+ Pos))
                )
                (t
                    (if (zerop ClnCnt)
                        (setq nStr (strcat nStr cChar))
                    )
                )
            )
            (setq Pos (1+ Pos))
            (setq oChar cChar)
        )
        (while (vl-string-search "\\{" nStr)
            (setq nStr (vl-string-subst "{" "\\{" nStr))
        )
        (while (vl-string-search "\\}" nStr)
            (setq nStr (vl-string-subst "}" "\\}" nStr))
        )
        (while (vl-string-search "\~" nStr)
            (setq nStr (vl-string-subst " " "\~" nStr))
        )
        nStr
    )
    ;----------------------------------------------------------
    (defun FontLetterWidth (Doc TextObj / MdSpc StyCol Sty FontName DictCol DictObj cnt CurLtr tempText ll ur Dist FontWidthList
        WidthList StyName String TextWd TextHt StyDictObj tempStrList tempList tempStr)
    ; Returns a list of distances for the text string of the object supplied.  The distances are that of each
    ;  letter in the string starting from the lower left bounding box point of the text, when the text is rotated
    ;  to 0.0 degrees.
    ; Idea from 'SomeCallMeDave' @ theswamp.  Thanks again.

    (setq StyName (vla-get-StyleName TextObj))
    (setq String (vla-get-TextString TextObj))
    (setq TextWd (vla-get-ScaleFactor TextObj))
    (setq TextHt (vla-get-Height TextObj))
    (setq TextLen (strlen String))
    (setq cnt -1)
    (while (setq cnt (vl-string-search "%%" String (setq cnt (1+ cnt))))
    (setq tempStrList (cons (cons (1+ cnt) (setq tempStr (strcase (substr String (1+ cnt) 3)))) tempStrList))
    )
    (setq MdSpc (vla-get-ModelSpace Doc))
    (setq StyCol (vla-get-TextStyles Doc))
    (setq Sty (vla-Item StyCol StyName))
    (setq FontName
    (if (findfile (vla-get-fontFile Sty))
    (vl-filename-base (vla-get-fontFile Sty))
    (vl-filename-base (getvar "fontalt"))
    )
    )
    ;(setq DictCol (vla-get-Dictionaries Doc))
    ;(if (vl-catch-all-error-p (setq DictObj (vl-catch-all-apply 'vla-Item (list DictCol "MyFontWidthDict"))))
    ; (setq DictObj (vla-Add DictCol "MyFontWidthDict"))
    ;)
    ;(if (vl-catch-all-error-p (setq StyDictObj (vl-catch-all-apply 'vla-Item (list DictObj StyName))))
    ; (setq StyDictObj (vla-Add DictObj StyName))
    ;)
    (setq cnt 1)
    (while (<= cnt TextLen)
    (if (setq tempList (assoc cnt tempStrList))
    (progn
    (setq CurLtr (cdr tempList))
    (setq cnt (+ cnt 2))
    )
    (setq CurLtr (substr String cnt 1))
    )
    (if (not (assoc CurLtr FontWidthList))
    (progn
    (cond
    ((= CurLtr " ")
    (setq tempText (vlax-invoke MdSpc 'AddText "AA" '(0.0 0.0 0.0) 1.0))
    (vla-put-Height tempText 1.0)
    (vla-put-ScaleFactor tempText 1.0)
    (vla-put-StyleName tempText StyName)
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq Dist (distance (cons (car ll) (cdr ur)) ur))
    (vla-put-TextString tempText (strcat "A" CurLtr "A"))
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq Dist (* TextWd (* TextHt (- (distance (cons (car ll) (cdr ur)) ur) Dist))))
    (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
    (vla-Delete tempText)
    )
    ((and (equal cnt 3) (or (= CurLtr "%%U") (= CurLtr "%%O")))
    (setq tempText (vlax-invoke MdSpc 'AddText "A" '(0.0 0.0 0.0) 1.0))
    (vla-put-Height tempText 1.0)
    (vla-put-ScaleFactor tempText 1.0)
    (vla-put-StyleName tempText StyName)
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq tempPt (cons (car ll) (cdr ur)))
    (vla-put-TextString tempText (strcat CurLtr "A"))
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq Dist (* TextWd (* TextHt (distance (cons (car ll) (cdr ur)) tempPt))))
    (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
    (vla-Delete tempText)
    )
    (T
    (setq tempText (vlax-invoke MdSpc 'AddText CurLtr '(0.0 0.0 0.0) 1.0))
    (vla-put-Height tempText 1.0)
    (vla-put-ScaleFactor tempText 1.0)
    (vla-put-StyleName tempText StyName)
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq Dist (distance (cons (car ll) (cdr ur)) ur))
    (vla-put-TextString tempText (strcat CurLtr CurLtr))
    (vla-GetBoundingBox tempText 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq Dist (* TextWd (* TextHt (- (distance (cons (car ll) (cdr ur)) ur) Dist))))
    (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
    (vla-Delete tempText)
    )
    )
    )
    )
    (if (and (not (equal cnt 3)) (or (= CurLtr "%%U") (= CurLtr "%%O")))
    (repeat 3
    (setq WidthList (cons 0.0 WidthList))
    )
    (if (or (= CurLtr "%%U") (= CurLtr "%%O"))
    (repeat 3
    (setq WidthList (cons (/ (cdr (assoc CurLtr FontWidthList)) 3.0) WidthList))
    )
    (setq WidthList (cons (cdr (assoc CurLtr FontWidthList)) WidthList))
    )
    )
    (setq cnt (1+ cnt))
    )
    ;(print FontWidthList)
    (list (reverse WidthList) tempStrList)
    )
    ;---------------------------------------------------------------
   
    (setq OwnrObj (vlax-invoke doc 'ObjectIdToObject (vla-get-OwnerId mtObj)))
    (setq MtWd (vla-get-Width mtObj))
    (setq MtHt (vla-get-Height mtObj))
    (setq MtSty (vla-get-StyleName mtObj))
    (setq MtRot (vla-get-Rotation mtObj))
    (setq MtLnSpc (vla-get-LineSpacingDistance mtObj))
    (setq StyWd (vla-get-Width (vla-Item (vla-get-TextStyles doc) (vla-get-StyleName mtObj))))
    (setq PropsList
        (cons
            (cons "ScaleFactor" StyWd)
            (mapcar
                (function
                    (lambda ( x )
                        (cons x (vlax-get mtObj x))
                    )
                )
                '("Color" "Layer" "Linetype" "LinetypeScale" "Lineweight" "Normal" "PlotStyleName" "Rotation" "TrueColor")
            )
        )
    )
   
    (setq tempStr (RemoveAllFormatting (setq mtStr (vla-get-TextString mtObj))))
    (setq StPos 1)
    (setq tempNum 0)
    (while (setq tempNum (vl-string-search "\\P" tempStr tempNum))
        (setq StrsList
            (cons
                (if (> StPos tempNum)
                    ""
                    (substr tempStr StPos (1+ (- tempNum StPos)))
                )
                StrsList
            )
        )
        (setq StPos (1+ (setq tempNum (+ 2 tempNum))))
    )
    (setq StrsList (cons (substr tempStr StPos) StrsList))
   
    (foreach str StrsList
        (setq tempNum 0)
        (setq SpList nil)
        (while (setq tempNum (vl-string-search " " str tempNum))
            (setq SpList (cons tempNum SpList))
            (setq tempNum (1+ tempNum))
        )
        (setq SpList (reverse SpList))
        (setq tempText (vlax-invoke OwnrObj 'AddText str '(0. 0. 0.) MtHt))
        (vla-put-StyleName tempText MtSty)
        (vla-put-ScaleFactor tempText StyWd)
        (setq tempList (FontLetterWidth doc tempText))
        (setq WdList (car tempList))
        (setq ExcptList (cadr tempList))
        (setq StPos 1)
        (setq WdCnt 0)
        (setq SpCnt 0)
        (while (<= StPos (strlen str))
            (setq tempWd 0)
            (setq EndPos 1)
            (while
                (and
                    (< WdCnt (length WdList))
                    (<= (setq tempWd (+ tempWd (nth WdCnt WdList))) MtWd)
                )
                (setq WdCnt (1+ WdCnt))
                (setq EndPos
                    (if (setq tempList (assoc WdCnt ExcptList))
                        (+ (1- (strlen (cdr tempList))) EndPos)
                        (1+ EndPos)
                    )
                )
            )
            (setq tempNum
                (if SpList
                    (nth SpCnt SpList)
                    -1
                )
            )
            (while
                (and
                    (< SpCnt (length SpList))
                    (> (1- (+ StPos EndPos)) (nth SpCnt SpList))
                )
                (setq tempNum (nth SpCnt SpList))
                (setq SpCnt (1+ SpCnt))
            )
            (if
                (or
  (and
                    (< tempWd MtWd)
                    (or
                        (>= SpCnt (length SpList))
                        (>= WdCnt (length WdList))
                    )
                  )
  (zerop MtWd)
)
                (setq tempNum (strlen str))
            )
            (setq StrList
                (cons
                    (substr
                        str
                        StPos
                        (if (< tempNum StPos)
                            (setq tempNum (+ StPos EndPos))
                            (- (1+ tempNum) StPos)
                        )
                    )
                    StrList
                )
            )
            (setq StPos (+ 2 tempNum))
            (setq WdCnt StPos)
        )
        (setq TxStrList (cons (reverse StrList) TxStrList))
        (setq StrList nil)
        (vla-Delete tempText)
    )
    (setq InsPt '(0. 0. 0.))
    (foreach lst TxStrList
        (if lst
            (foreach str lst
                (print str)
                (setq TxObjList (cons (setq tempText (vlax-invoke OwnrObj 'AddText str InsPt MtHt)) TxObjList))
                (vla-put-StyleName tempText MtSty)
                (if (not flag)
                    (progn
                        (setq tempMtObj (vlax-invoke mtObj 'Copy))
                        (vla-put-Rotation tempMtObj 0.)
                        (vla-GetBoundingBox tempMtObj 'll 'ur)
                        (setq ll (safearray-value ll))
                        (setq ur (safearray-value ur))
                        (setq AtchPt (vla-get-AttachmentPoint mtObj))
                        (setq tempPt
                            (list
                                (cond
                                    ((member AtchPt '(1 4 7))
                                        (setq Ali 0)
                                        (car ll)
                                    )
                                    ((member AtchPt '(2 5 8))
                                        (setq Ali 4)
                                        (* (+ (car ll) (car ur)) 0.5)
                                    )
                                    ((member AtchPt '(3 6 9))
                                        (setq Ali 2)
                                        (car ur)
                                    )
                                )
                                (cadr ur)
                                (caddr ll)
                            )
                        )
                        (vla-put-Alignment tempText Ali)
                        (vla-GetBoundingBox tempText 'll 'ur)
                        (setq ll (safearray-value ll))
                        (setq ur (safearray-value ur))
                        (vlax-invoke
                            tempText
                            'Move
                            (list
                                (cond
                                    ((member AtchPt '(1 4 7))
                                        (car ll)
                                    )
                                    ((member AtchPt '(2 5 8))
                                        (* (+ (car ll) (car ur)) 0.5)
                                    )
                                    ((member AtchPt '(3 6 9))
                                        (car ur)
                                    )
                                )
                                (cadr ur)
                                (caddr ll)
                            )
                            tempPt
                        )
                        (vlax-invoke tempText 'Rotate (vlax-get tempMtObj 'InsertionPoint) MtRot)
                        (setq InsPt
                            (if (equal Ali 0)
                                (vlax-get tempText 'InsertionPoint)
                                (vlax-get tempText 'TextAlignmentPoint)
                            )
                        )
                        (setq PropsList (cons (cons "Alignment" Ali) PropsList))
                        (setq flag T)
                        (vla-Delete tempMtObj)
                    )
                )
                (foreach i PropsList
                    (vl-catch-all-apply 'vlax-put (list TempText (car i) (cdr i)))
                )
                (vlax-put tempText (if (equal Ali 0) "InsertionPoint" "TextAlignmentPoint") InsPt)
                (setq InsPt (polar InsPt (rem (+ MtRot (* pi 1.5)) (* pi 2.)) MtLnSpc))
            )
            (setq InsPt (polar InsPt (rem (+ MtRot (* pi 1.5)) (* pi 2.)) MtLnSpc))
        )
    )
    (reverse TxObjList)
)

Thanks go out to T.Willey and everyone else who has contributed to this excellent script.

gotnone