Author Topic: Text to Mtext AutoCAD 2015 (Read 15114 times)

Andrew · « **on:** April 14, 2014, 02:43:45 AM »

I have a great text to mtext lisp that I downloaded years ago, I'm not sure where I found it so sorry for not giving credit.

It worked fine in autocad 2014, but in autocad 2015 it gives this error when I try and run it after selecting multiple texts to convert. Does anyone know what needs to be changed to make it work in 2015?

Quote

Select objects: Specify opposite corner: 54 found

Select objects:
VVC Internal Error

Code: [Select]

(defun c:t2mt (/ ss lst usercmd)
  ;;  CAB Text to Mtext conversion
  (defun T2M (code)
    ;; code =  dText Alignment code
    (cdr 
      (assoc code
	      '(( 0 ;|acAlignmentLeft        |; . acAttachmentPointBottomLeft)
               ( 1 ;|acAlignmentCenter      |; . acAttachmentPointBottomCenter)
               ( 2 ;|acAlignmentRight       |; . acAttachmentPointBottomRight)
               ( 3 ;|acAlignmentAligned     |; . acAttachmentPointBottomLeft)
               ( 4 ;|acAlignmentMiddle      |; . acAttachmentPointMiddleCenter)
               ( 5 ;|acAlignmentFit         |; . acAttachmentPointBottomLeft)
               ( 6 ;|acAlignmentTopLeft     |; . acAttachmentPointTopLeft)
               ( 7 ;|acAlignmentTopCenter   |; . acAttachmentPointTopCenter)
               ( 8 ;|acAlignmentTopRight    |; . acAttachmentPointTopRight)
               ( 9 ;|acAlignmentMiddleLeft  |; . acAttachmentPointMiddleLeft)
               (10 ;|acAlignmentMiddleCenter|; . acAttachmentPointMiddleCenter) 
               (11 ;|acAlignmentMiddleRight |; . acAttachmentPointMiddleRight)
               (12 ;|acAlignmentBottomLeft  |; . acAttachmentPointBottomLeft)
               (13 ;|acAlignmentBottomCenter|; . acAttachmentPointBottomCenter) 
               (14 ;|acAlignmentBottomRight |; . acAttachmentPointBottomRight))
     ))
  )
  (command "_Undo" "_end")
  (command "_Undo" "_begin")
  (setq ss (ssget '((0 . "TEXT")))) ; get only plain text
  (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (mapcar
    '(lambda (x)
       (setq obj (vlax-ename->vla-object x)
             ali (vla-get-alignment obj)
             ipt (vlax-get obj 'InsertionPoint)
             apt (vlax-get obj 'Textalignmentpoint)
       )
       (command "txt2mtxt" x "")
       (setq new (vlax-ename->vla-object(entlast)))
       (vla-put-AttachmentPoint new (eval (t2m ali)))
       (if (equal apt '(0.0 0.0 0.0))
         (vlax-put new 'InsertionPoint ipt)
         (vlax-put new 'InsertionPoint apt)
       )
       (vla-put-width new 3.5)
       
     )
    lst
  )
  (setvar "CMDECHO" usercmd)
  (command "_Undo" "_end")
  (princ)
)
(defun c:t2mtsetout (/ ss lst usercmd)
  ;;  CAB Text to Mtext conversion
  (defun T2M (code)
    ;; code =  dText Alignment code
    (cdr 
      (assoc code
	      '(( 0 ;|acAlignmentLeft        |; . acAttachmentPointBottomLeft)
               ( 1 ;|acAlignmentCenter      |; . acAttachmentPointBottomCenter)
               ( 2 ;|acAlignmentRight       |; . acAttachmentPointBottomRight)
               ( 3 ;|acAlignmentAligned     |; . acAttachmentPointBottomLeft)
               ( 4 ;|acAlignmentMiddle      |; . acAttachmentPointMiddleCenter)
               ( 5 ;|acAlignmentFit         |; . acAttachmentPointBottomLeft)
               ( 6 ;|acAlignmentTopLeft     |; . acAttachmentPointTopLeft)
               ( 7 ;|acAlignmentTopCenter   |; . acAttachmentPointTopCenter)
               ( 8 ;|acAlignmentTopRight    |; . acAttachmentPointTopRight)
               ( 9 ;|acAlignmentMiddleLeft  |; . acAttachmentPointMiddleLeft)
               (10 ;|acAlignmentMiddleCenter|; . acAttachmentPointMiddleCenter) 
               (11 ;|acAlignmentMiddleRight |; . acAttachmentPointMiddleRight)
               (12 ;|acAlignmentBottomLeft  |; . acAttachmentPointBottomLeft)
               (13 ;|acAlignmentBottomCenter|; . acAttachmentPointBottomCenter) 
               (14 ;|acAlignmentBottomRight |; . acAttachmentPointBottomRight))
     ))
  )
  (command "_Undo" "_end")
  (command "_Undo" "_begin")
  (setq ss (ssget '((0 . "TEXT")))) ; get only plain text
  (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (mapcar
    '(lambda (x)
       (setq obj (vlax-ename->vla-object x)
             ali (vla-get-alignment obj)
             ipt (vlax-get obj 'InsertionPoint)
             apt (vlax-get obj 'Textalignmentpoint)
       )
       (command "txt2mtxt" x "")
       (setq new (vlax-ename->vla-object(entlast)))
       (vla-put-AttachmentPoint new (eval (t2m ali)))
       (if (equal apt '(0.0 0.0 0.0))
         (vlax-put new 'InsertionPoint ipt)
         (vlax-put new 'InsertionPoint apt)
       )
       (vla-put-width new 0)
       
     )
    lst
  )
  (setvar "CMDECHO" usercmd)
  (command "_Undo" "_end")
  (princ)
)

Kerry · « **Reply #1 on:** April 14, 2014, 03:08:46 AM »

The code appears to have been written by CAB http://www.theswamp.org/index.php?action=profile;u=30

He doesn't have AC2015 to test with.

Can you isolate the error to a specific line using the VLIDE Editor ?

ChrisCarlson · « **Reply #2 on:** April 14, 2014, 07:55:46 AM »

I didn't dig too deep into this but what about using the inbuilt txt2mtxt command within AutoCAD?

Andrew · « **Reply #3 on:** April 14, 2014, 06:49:19 PM »

Thanks for the replies.

This lisp is a bit different to the inbuilt txt2mtxt command, it converts text to mtext individually and puts them in the same location whereas the inbuilt in one combines them. It's quite handy converting lots of individual txt to mtxt.

I tried using VLIDE but I'm not really sure what it's telling me.
If I run t2mt on one text only and do an error trace one of the items in VLIDE is this

Code: [Select]

(mapcar
    '(lambda (x)
       (setq obj (vlax-ename->vla-object x)
             ali (vla-get-alignment obj)
             ipt (vlax-get obj 'InsertionPoint)
             apt (vlax-get obj 'Textalignmentpoint)
       )
       (command "txt2mtxt" x "")
       (setq new (vlax-ename->vla-object(entlast)))
       (vla-put-AttachmentPoint new (eval (t2m ali)))
       (if (equal apt '(0.0 0.0 0.0))
         (vlax-put new 'InsertionPoint ipt)
         (vlax-put new 'InsertionPoint apt)
       )
       (vla-put-width new 3.5)
       
     )
    lst
  )

and it gives an error in the autocad text window

Code: [Select]

Select text objects, or [Options]<Options>: ; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on exception
; error: Exception occurred: 0xC0000005 (Access Violation)

If I use t2mt on multiple text items I can't seem to see where the error occurs in VLIDE. (This one gives the VVC Internal Error in the autocad text window)

gile · « **Reply #4 on:** April 27, 2014, 09:23:50 AM »

Hi,

Try replacing (command "txt2mtxt" x "") with (command-s "txt2mtxt" x "").
I had the same error (VVC: Internal Error) with A2015 in a LISP function which called vl-cmdf within a mapcar statement and replacing vl-cmdf with command-s solved it.

Andrew · « **Reply #5 on:** April 27, 2014, 08:20:16 PM »

Thanks gile. That got rid of the VVC: Internal error.

I've got another issue now. When a TEXT has alignment Left it moves the converted MTEXT to 0,0. It only seems to do this for TEXT with alignment left. If the alignment is anything else, right, centre, align etc it places it correctly in the same location.

I'm guessing it has something to do with this section. Any ideas?

Code: [Select]

      (assoc code
	      '(( 0 ;|acAlignmentLeft        |; . acAttachmentPointBottomLeft)
               ( 1 ;|acAlignmentCenter      |; . acAttachmentPointBottomCenter)
               ( 2 ;|acAlignmentRight       |; . acAttachmentPointBottomRight)
               ( 3 ;|acAlignmentAligned     |; . acAttachmentPointBottomLeft)
               ( 4 ;|acAlignmentMiddle      |; . acAttachmentPointMiddleCenter)
               ( 5 ;|acAlignmentFit         |; . acAttachmentPointBottomLeft)
               ( 6 ;|acAlignmentTopLeft     |; . acAttachmentPointTopLeft)
               ( 7 ;|acAlignmentTopCenter   |; . acAttachmentPointTopCenter)
               ( 8 ;|acAlignmentTopRight    |; . acAttachmentPointTopRight)
               ( 9 ;|acAlignmentMiddleLeft  |; . acAttachmentPointMiddleLeft)
               (10 ;|acAlignmentMiddleCenter|; . acAttachmentPointMiddleCenter) 
               (11 ;|acAlignmentMiddleRight |; . acAttachmentPointMiddleRight)
               (12 ;|acAlignmentBottomLeft  |; . acAttachmentPointBottomLeft)
               (13 ;|acAlignmentBottomCenter|; . acAttachmentPointBottomCenter) 
               (14 ;|acAlignmentBottomRight |; . acAttachmentPointBottomRight))
     ))

Kerry · « **Reply #6 on:** April 27, 2014, 11:52:02 PM »

Quote from: gile on April 27, 2014, 09:23:50 AM

Hi,

Try replacing (command "txt2mtxt" x "") with (command-s "txt2mtxt" x "").
I had the same error (VVC: Internal Error) with A2015 in a LISP function which called vl-cmdf within a mapcar statement and replacing vl-cmdf with command-s solved it.

Thanks gile.
I was afraid of that with ac2015

fixo · « **Reply #7 on:** April 28, 2014, 04:45:26 AM »

Quote from: Andrew on April 27, 2014, 08:20:16 PM

I'm guessing it has something to do with this section. Any ideas?

See the very last post by T.Willey in this thread :
https://groups.google.com/forum/#!topic/autodesk.autocad.customization/gGZBLTD3Qls

maicy · « **Reply #8 on:** April 30, 2014, 03:07:58 AM »

in AutoCAD 2015,mapcar can't use command
(mapcar
'(lambda (x)
......
(command.....)
....
)
)

Marc'Antonio Alessi · « **Reply #9 on:** May 02, 2014, 09:05:33 AM »

Quote from: gile on April 27, 2014, 09:23:50 AM

Hi,
Try replacing (command "txt2mtxt" x "") with (command-s "txt2mtxt" x "").
I had the same error (VVC: Internal Error) with A2015 in a LISP function which called vl-cmdf within a mapcar statement and replacing vl-cmdf with command-s solved it.

Thank you for reporting this type of problem and the solution, my question is on using "command" in this scenario:

vla-Open dwg file
(vl-cmdf "_.VBASTMT" "documents.item(documents.count-1).sendcommand \"(load \"\"LispFile\"\")\n\"")

Loading (and run inside itself) LispFile with sendcommand I can execute all I need (plot, export, etc.) and when I close the document the control go back to the starting document. I think it is a better method than scripts especially for errors check.

I thought I should abandon this method because it is very slow in 64-bit systems (due to the VBA 6/64), but in AutoCAD 2014 (with VBA 7) is back to being useful.

Now in 2015, with the elimination of "fibres", (I have read also your http://cadxp.com/topic/39448-compatibilite-autocad-2015/) I have several new problems:

Edit: see new thread: http://www.theswamp.org/index.php?topic=47005.0

andrew_nao · « **Reply #10 on:** May 05, 2014, 01:20:00 PM »

Quote from: Marc'Antonio Alessi on May 02, 2014, 09:05:33 AM

Thank you for reporting this type of problem and the solution, my question is on using "command" in this scenario:

vla-Open dwg file
(vl-cmdf "_.VBASTMT" "documents.item(documents.count-1).sendcommand \"(load \"\"LispFile\"\")\n\"")

...

Suggestions?

my suggestion is to drop that method and use this one by Lee Mac

Code: [Select]

;;  Author: Lee Mac,
(defun LM:Open ( target / shell result )
    (if
        (and
            (or
                (eq 'INT (type target))
                (setq target (findfile target))
            )
            (setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
        )
        (progn
            (setq result (vl-catch-all-apply 'vlax-invoke (list shell 'open target)))
            (vlax-release-object shell)
            (not (vl-catch-all-error-p result))
        )
    )
)
(vl-load-com)

Example to Open a File Selected by the User
(LM:Open (getfiled "Select File to Open" "" "" 16))

Example to Open a Drawing File at a Specified Location:
(LM:Open "C:\\My Folder\\File.dwg")

Example to Open a Directory:
(LM:Open "C:\\My Folder\\My SubFolder")

Marc'Antonio Alessi · « **Reply #11 on:** May 05, 2014, 01:41:49 PM »

Quote from: andrew_nao on May 05, 2014, 01:20:00 PM

...
Example to Open a Drawing File at a Specified Location:
(LM:Open "C:\\My Folder\\File.dwg")
...

Ok but how can I execute commands in the openeded file and close it?

(progn
(LM:Open "C:\\Temp\\pippo.dwg")
(command "_line" "0,0" "10,10" "")
(command "_.CLOSE" "_Y")
)
...
Loading (and run inside itself) LispFile with sendcommand I can execute all I need (plot, export, etc.) and when I close the document the control go back to the starting document. I think it is a better method than scripts especially for errors check.
...

pedroantonio · « **Reply #12 on:** May 06, 2014, 06:54:38 PM »

I use this lisp.Try it !!

Code - Auto/Visual Lisp: [Select]

;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;; 11.05.2010 added grouping text by Y values if in same column
;;; 11.11.2010 added some conversions for underline and overline
(defun c:t2mt (/          rjp-txtschtuff      rjp-ent2obj         rjp-getbbwdth       rjp-getbbtlc
                rjp-dxf   doc       fuz-p     fuz-x     fuz-y     hgt       i         obj
                otxt      pt        ss        tmp       txt       w         x         x-srt
                y         y-srt
               )
  ;;Added some conversion stuff per Joe's comment ... not gonna get too crazy about the formatting rabbit hole :P
  (defun rjp-txtschtuff (txt)
    ;;ExtraSpaces
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    ;;Underlines, Overlines
    (foreach x '(("%%U" . "\\L") ("%%O" . "\\O"))
      (cond ((vl-string-search (car x) txt)
             (while (vl-string-search (car x) txt) (setq txt (vl-string-subst (cdr x) (car x) txt)))
             (setq txt (strcat "{" txt "}"))
            )
      )
    )
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  ;;**Textheight multipliers**
  ;;The max X grouping variance
  (setq fuz-x 3)
  ;;The max Y grouping variance
  (setq fuz-y 4)
  ;;Determine the max Y line spacing variance before making into paragraph
  (setq fuz-p 2.5)
  ;;**Textheight multipliers**
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
           ;;list as X Y TEXT ENAME
           (setq ss (mapcar '(lambda (x)
                               (list (car (rjp-dxf 10 x))
                                     (cadr (rjp-dxf 10 x))
                                     (strcat (rjp-txtschtuff (rjp-dxf 1 x)) " ")
                                     x
                               )
                             )
                            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                    )
           )
           (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      )
    (progn ;;Sort top to bottom
           (setq ss (vl-sort ss '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
           ;;Group by x values using (*  fuz-x textheight)
           (while (setq i (car ss))
             (setq y (vl-remove-if-not
                       '(lambda (x) (equal (car i) (car x) (* fuz-x (rjp-dxf 40 (last i)))))
                       ss
                     )
             )
             (mapcar '(lambda (x) (setq ss (vl-remove x ss))) y)
             (setq x-srt (cons (mapcar 'cdr y) x-srt))
           )
           (foreach i x-srt
             ;;Substract subsequent Y values starting at top
             (setq y (mapcar '(lambda (x y) (cons (- (car x) (car y)) (cdr x)))
                             i
                             (append (cdr i) (list (last i)))
                     )
             )
             ;;Group while Y distance is less than (* fuz-y toptextheight)
             (while y
               (setq tmp nil)
               (setq tmp (cons (car y) tmp))
               (setq hgt (rjp-dxf 40 (last (car y))))
               (while (and (cdr y) (< (caar y) (* fuz-y hgt)))
                 (setq y (cdr y))
                 (setq tmp (cons (car y) tmp))
               )
               (setq y-srt (cons (reverse tmp) y-srt))
               (setq y (cdr y))
             )
           )
           (foreach item (reverse y-srt)
             (setq txt  nil
                   ;;Get widest piece of text to set mtext width
                   w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'caddr item)) '>)))
                   hgt  (rjp-dxf 40 (last (car item)))
                   pt   (rjp-getbbtlc (last (car item)))
                   ;;Grab top text to pull properties from
                   otxt (vlax-ename->vla-object (last (car item)))
                   ;;Join the text into one string breaking into paragraphs if greater than (* fuz-p toptextheight)
                   txt  (apply 'strcat
                               (mapcar '(lambda (x)
                                          (if (> (car x) (* fuz-p hgt))
                                            (strcat (cadr x) "\\P\\P")
                                            (cadr x)
                                          )
                                        )
                                       item
                               )
                        )
             )
             ;;Insert mtext
             (setq obj (vla-addmtext
                         (if (= (getvar 'cvport) 1)
                           (vla-get-paperspace doc)
                           (vla-get-modelspace doc)
                         )
                         (vlax-3d-point pt)
                         w
                         txt
                       )
             )
             ;;Match properties from top text object
             (vla-put-height obj (vla-get-height otxt))
             (vla-put-attachmentpoint obj actopleft)
             (vlax-put obj 'insertionpoint pt)
             (vla-put-rotation obj 0.0)
             (vla-put-layer obj (vla-get-layer otxt))
             (vla-put-stylename obj (vla-get-stylename otxt))
             ;;(grdraw (car (rjp-getbb obj)) (cadr (rjp-getbb obj)) 1)
             ;;Delete single line text
             (mapcar 'entdel (mapcar 'last item))
           )
    )
  )
  (princ)
)
 

cmwade77 · « **Reply #13 on:** May 06, 2014, 07:39:25 PM »

Quote from: Topographer on May 06, 2014, 06:54:38 PM

I use this lisp.Try it !!

I use this one as well (along with modified versions in some of my routines) and I can confirm that it works in 2015.

Alternatively, you could use Lee Mac's version:
http://www.lee-mac.com/text2mtext.html

It works well too, even in 2015.

Chris · « **Reply #14 on:** August 20, 2014, 10:35:37 AM »

I've got a question on Ron's lisp, sorry, I haven't looked for the original post (not to mention it is quite old)
I would like to use Ron's program to combine text that is generated from GIS shape files into single pieces of text. The program converts all the text to mtext, but not as a paragraph. what I'm finding is that when listing the insertion points, it is rounding the y coord to 1 significant figure (and the x coord is in scientific notation). I'm guessing this is because we are on state plane coordinates (huge numbers). Is there anyway to force the insertion point properties to hold more than 1 decimal? as it is running now, it thinks all the text is on top of itself.

Thanks,

ronjonp · « **Reply #15 on:** August 20, 2014, 11:00:53 AM »

Do you have a sample drawing ?

Chris · « **Reply #16 on:** August 20, 2014, 11:03:18 AM »

yes I do, please see attached
it is 2015 format

ronjonp · « **Reply #17 on:** August 20, 2014, 12:24:30 PM »

Chris,

Give this version a try

Chris · « **Reply #18 on:** August 20, 2014, 12:41:02 PM »

Thanks for looking at it, that works great.

ronjonp · « **Reply #19 on:** August 20, 2014, 12:55:46 PM »

Quote from: Chris on August 20, 2014, 12:41:02 PM

Thanks for looking at it, that works great.

Glad to help.

Please test it out a bit, I did not test too thoroughly.

Chris · « **Reply #20 on:** August 20, 2014, 01:03:25 PM »

will do, I'll let you know if I find any issues.

CAB · « **Reply #21 on:** August 27, 2014, 08:29:11 AM »

Quote from: Andrew on April 14, 2014, 02:43:45 AM

I have a great text to mtext lisp that I downloaded years ago, I'm not sure where I found it so sorry for not giving credit.

It worked fine in autocad 2014, but in autocad 2015 it gives this error when I try and run it after selecting multiple texts to convert. Does anyone know what needs to be changed to make it work in 2015?

That's an old routine, I use this now.

Code: [Select]

;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +                   Text 2 Mtext                         +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2012                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at TheSwamp.org                             +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; 
;;; VERSION
;;;  1.2 Apr 18, 2011  honers UCS 
;;;  1.3 Jun 25, 2011  added mtext to be combined
;;;  1.4 Jan 03, 2012  bug removal
;;; 
;;; FUNCTION 
;;;  Replace plain text with Mtext from user selection set
;;; 
;;; USAGE 
;;;  t2mt at command line, (t2mt eolchr trimspc 0width) from lisp
;;; 
;;; ARGUMENTS 
;;;  see "Command Line Call"
;;; 
;;;  RETURNS
;;;   Mtext Object, see note
;;; 
;;; PLATFORMS 
;;;  2000+ Tested in 2000-6 only
;;;  Requires sub function (get_group_boundingbox lst ) & (box_dtext ent)
;;;
;;; KNOWN ISSUES
;;;  User must select text after command is initiated
;;;  Loss of plain text formatting & width
;;;  Does not detect line spacing or blank lines
;;;  Does not detect indents unless leading spaces were used in plain text
;;;  Left most text determines the left justification point
;;;  Does not ignore text out of alignment, side by side text is added as a new line

;|
  Pseudo Code
  User selects plain text in a selection set. (future release may include mtext)
  Step through the entities selected
  Collect in separate list the string, the entity name, the Text bounding box coordinates.
  Strip trailing spaces if flagged and then add the end of line character. May be a space or hard return

Get a bounding box of all the boxes to get the upper left most point for inserting the mtext object and the angle of the text
Use individual bounding box coordinates to sort the text based on distance from the upper left most point.
*** Note that this method fails if some of the text objects are out of vertical alignment.
Combine the list of strings into one string, does not account for skiped lines (blank rows)
Sort the entity list so we can use the first text object to get height, layer, style etc. from
Create the new Mtext object with width per flag
Set text height from the first /top plain text object
Correct attachment point of mtext
Set the layer, style,and proper rotation per angle collected
Delete the old text objects 

Note that side by side objects are combined vertically


 Flag variables:
  eolchr  EndOfLineCharacter set to " " or "\\P"     use space " " to wrap lines else use hard return "\\P"
  trimspc TrimSpaces t= remove trailing spaces else no action
  0width  zero Width if true sets width to zero else get width of widest string and add 10%
|;

;;  -=<  command line call  >=-
(defun c:t2mt ()
  (t2mt  "\\P"  ; use space " " to wrap lines else "\\P"        
         t      ; t= remove trailing spaces                     
         nil)   ; t= zero width else get width of widest string.
  (princ) ; supress mtext object return
)


;;  -=<  actual lisp routine  >=-
(defun t2mt (eolchr   ; use space " " to wrap lines else "\\P"        
             trimspc  ; t= remove trailing spaces                     
             0width   ; t= zero width else get width of widest string.
             / BoxLst doc    elst   ent   EntLst i    lspc   NewTxt t2mtVersion
               obj    pt     ss     str   TxtLst wid  x      ylst   eolchr trimspc
               DisLst txtObj ul ur in
              )
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq t2mtVersion "1.4")
  
  (defun stripText (str / new pat uc lc)
    (mapcar(function(lambda(new pat ) (setq str (vl-string-subst new pat str))))
           (list "°"   "°"   "±"    "±"  "Ø"   "Ø"   "%")
           (list "%%d" "%%D" "%%p" "%%P" "%%c" "%%C" "%%%"))
    (setq new "\\L")
    (while ; underline
      (progn
        (setq uc (vl-string-search "&&U" str))
        (setq lc (vl-string-search "&&u" str))
        (or uc lc)
      )
    ) ; end while underline
    str
  )
  
  ;; pt on p1-p2 as a perp from rp, planar, same Coord Sys; 
  (defun perp_p (rp p1 p2)
    (inters p1 p2 rp (poLar rp (+ (angLe p1 p2) (/ pi 2)) 1.0) niL ) 
  )

  
  (prompt (strcat "\n("t2mtVersion") Select text to combine."))
  (if (setq ss (ssget ":L" (list '(0 . "text,mtext"))))
    (progn
      ;;------------------------------------------------------------------------------------------
      (setq i  -1
            wid 0                       ; max line width
      )
      (while (setq ent (ssname ss (setq i (1+ i))))
        (setq EntLst (cons ent EntLst)
              elst   (entget ent) ; to be delete later
        )                              

        (cond
         ((equal (assoc 0 elst) '(0 . "TEXT")) ; Plain Text
            (setq BoxLst (cons (box_dtext ent) BoxLst)) ; ((ll lr ur ul)(ll lr ur ul)...)
            (setq wid (max wid (distance (caar BoxLst) (cadar BoxLst))))
            (setq str  (stripText (cdr (assoc 1 elst))))
            (and trimspc (setq str (vl-string-right-trim " " str))) ; remove trailing spaces
            (setq TxtLst (cons (strcat str eolchr) TxtLst))
         )
          ;;  process Mtext 
         ((equal (assoc 0 elst) '(0 . "MTEXT")) 
            (setq BoxLst (cons (box_mtext ent) BoxLst)) ; ((ll lr ur ul)(ll lr ur ul)...)
            (setq wid (max wid (distance (caar BoxLst) (cadar BoxLst))))
            (setq str  (cdr (assoc 1 elst)))
            (and trimspc (setq str (vl-string-right-trim " " str))) ; remove trailing spaces
            (setq TxtLst (cons str TxtLst))
          )
        )
      ) ; end while
      ;;------------------------------------------------------------------------------------------
      (setq bb (get_group_boundingbox BoxLst) ; (ll lr ur ul)
            ul (last bb)
            ur (caddr bb)
            ;ang (angle (car bb)(cadr bb))
            ang (angle ul ur)
            pt ul ;(last bb)) ; get ul
      )
      
      ;;  Using Upper Left as a referance point sort text objects per distance
      ;(mapcar(function(lambda(x) (setq DisLst (cons (distance pt (car x)) DisLst)))) (reverse BoxLst))
      ;;  referance point is now perpendicular point on ray ul ur
      (mapcar(function(lambda(x) (setq DisLst (cons (distance (car x) (perp_p (car x) ul ur)) DisLst)))) (reverse BoxLst))
      (setq TxtLst (mapcar '(lambda (x) (nth x TxtLst)) (vl-sort-i DisLst '<))) ; sort by distance
      ;;  =========================================================================

      ;;  Sort the entity list so we can use the first text object to get height, layer, style etc. from
      (setq EntLst (mapcar '(lambda (x) (nth x EntLst)) (vl-sort-i DisLst '<)))

      ;;(setq NewTxt (apply 'strcat TxtLst)) ; combine into one text string
      ;;  revised to add blank rows when needed, based on distance
      (setq DisLst (vl-sort dislst '<))
      
      (foreach str TxtLst
        (if in
            (if (equal (+ step in) (car dislst) 0.5)
              (setq NewTxt (strcat NewTxt str))
              (setq NewTxt (strcat NewTxt eolchr str))
            )
          (setq in (* 1.5625 (car dislst))
                NewTxt str)
        )
        (setq step (car dislst)
              dislst (cdr dislst))
      )

      ;; create mtext
      (setq obj (vla-addmtext
                  (if (= (getvar 'cvport) 1)
                    (vla-get-paperspace doc)
                    (vla-get-modelspace doc)
                  )
                  (vlax-3d-point (trans pt 1 0))
                  (if 0width 0.0 (* wid 1.1)) ; set mtext width
                  NewTxt
                )
      )

      ;; Match properties from plain text object
      (setq txtObj (vlax-ename->vla-object (car EntLst)))
      (vla-put-height obj (vla-get-height txtObj))
      (vla-put-attachmentpoint obj actopleft)  ;   <----<<<  Top Left
      (vlax-put obj 'insertionpoint (trans pt 1 0))
      (vla-put-rotation obj ang)
      (vla-put-layer obj (vla-get-layer txtObj))
      (vla-put-stylename obj (vla-get-stylename txtObj))

      (mapcar 'entdel EntLst)             ; Delete selected single line text
    )
  )
  obj
) 

;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +            get_group_boundingbox.lsp                   +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005-2010                      +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at TheSwamp.org                             +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; 
;;; Get a bounding box for a group of bounding boxes
;;; Use the base of the first box as a referance angle that will be
;;; the base angle of the box returned
;;;
;;;   argument 'all; is a list of 4 point lists defining the group of boxes
;;;   returns (ll lr ur ul)
 (defun get_group_boundingbox (all / ld lb rd rb bd bb td tb tmp refpt angr
                               ang angr s1 s2 pt  anglst intersect dist)

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; return intersect point between two borders
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  (defun intersect (s1 s2 ang / angr)
    (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
      (setq angr (- ang (* pi 1.5))) ; -270 deg
      (setq angr (+ ang (/ pi 2))) ; +90 deg
    )
    (inters s1 (polar s1 angr 10) s2 (polar s2 ang 10) nil)
  ) ; end defun

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;; calc distance & perpenduclar point on border
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  (defun dist (p1 ang p3 p4 / p2 p5 d angp1p5)
    (setq p2 (polar p1 ang 10) ; point on line at angle
          p5 (inters p1 p2 p3 p4 nil) ; perpendicular point
          d  (distance p1 p5)  ;;  <-----------<<<   fails when 2 text ae side by side
    )
    ;;  this is needed when angp1p5 is = 2pi
    (if (equal (angle p1 p5) (* 2 pi) 0.00001)
      (setq angp1p5 0.0)
      (setq angp1p5 (angle p1 p5))
    )
    (if (equal angp1p5 ang 0.00001)
      (list (distance p1 p5) p5)
      (list (- (distance p1 p5)) p5)
    )
    ;;  returns (dist point)
  ) ; end defun


   ;;  /*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
   ;;   start of get_group_boundingbox  
   ;;  \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\


   ;;  05/14/2012 flatten the boxes
   (setq all (foreach lst All (mapcar '(lambda(x) (list (car x)(cadr x))) lst)))

   
  (setq ld    0 ; ld Left Distance : lb Left Broder pt
        rd    0
        td    0
        bd    0
        ;; constant referance point for calcs, it is within the first box
        refpt (polar (caar all) (angle (caar all) (caddar all))
                     (/ (distance (caar all) (caddar all)) 2))
        ang   (angle (caar all) (cadar all)) ; constant angle for calcs
        angr  (if (>= ang (* pi 1.5)) ; ANGLE PLUS 90 DEG
                (- ang (* pi 1.5)) ; -270 deg
                (+ ang (/ pi 2)) ; +90 deg
              )
  )
  ;;  this is needed when ang is = 2pi
  (if (equal ang (* 2 pi) 0.00001)
    (setq ang 0.0)
  )
  ;;  find point on outer most border 
  (foreach pt all
    ;; Right Border (ll lr ur ul) -> lr ur -> (cadr pt) (caddr pt)
    (if (>= (car (setq tmp (dist refpt ang (cadr pt) (caddr pt)))) rd)
      (setq rb (cadr tmp) ; new border point
            rd (car tmp)  ; new distance
      )
    )
    ;; Left Border (ll lr ur ul) -> ll ul -> (car pt) (cadddr pt)
    (if (<= (car (setq tmp (dist refpt ang (car pt) (cadddr pt)))) ld)
      (setq lb (cadr tmp) ; new border point
            ld (car tmp)  ; new distance
      )
    )
    ;; Top Border (ll lr ur ul) -> ur ul -> (cadr pt) (caddr pt)
    (if (>= (car (setq tmp (dist refpt angr (caddr pt) (cadddr pt)))) td)
      (setq tb (cadr tmp) ; new border point
            td (car tmp)  ; new distance
      )
    )

    ;; Bottom Border (ll lr ur ul) -> ll lr -> (car pt) (cadddr pt)
    (if (<= (car (setq tmp (dist refpt angr (car pt) (cadr pt)))) bd)
      (setq bb (cadr tmp) ; new border point
            bd (car tmp)  ; new distance
      )
    )
  ) ; foreach
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-


  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;      get intersect point between two borders       
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;  Left Border & Bottom Border = Lower left pt
  (list (intersect lb bb ang) ; ll 
        (intersect rb bb ang) ; lr 
        (intersect rb tb ang) ; ur 
        (intersect lb tb ang) ; ul 
  )
   ;;  returns (ll lr ur ul)
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

) ; end defun get_group_boundingbox

flyfox1047 · « **Reply #22 on:** September 29, 2014, 03:57:36 AM »

Quote from: CAB on August 27, 2014, 08:29:11 AM

Quote from: Andrew on April 14, 2014, 02:43:45 AM
I have a great text to mtext lisp that I downloaded years ago, I'm not sure where I found it so sorry for not giving credit.

It worked fine in autocad 2014, but in autocad 2015 it gives this error when I try and run it after selecting multiple texts to convert. Does anyone know what needs to be changed to make it work in 2015?

That's an old routine, I use this now.

Good routine. thanks Alan.

News:

Author Topic: Text to Mtext AutoCAD 2015 (Read 15114 times)

Andrew

ChrisCarlson

Andrew

Andrew

fixo

andrew_nao

pedroantonio

flyfox1047