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

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Text to Mtext AutoCAD 2015
« Reply #15 on: August 20, 2014, 11:00:53 AM »
Do you have a sample drawing ?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Chris

  • Swamp Rat
  • Posts: 547
Re: Text to Mtext AutoCAD 2015
« Reply #16 on: August 20, 2014, 11:03:18 AM »
yes I do, please see attached
it is 2015 format
Christopher T. Cowgill, P.E.
AEC Collection 2020 (C3D)
Win 10

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Text to Mtext AutoCAD 2015
« Reply #17 on: August 20, 2014, 12:24:30 PM »
Chris,

Give this version a try  :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Chris

  • Swamp Rat
  • Posts: 547
Re: Text to Mtext AutoCAD 2015
« Reply #18 on: August 20, 2014, 12:41:02 PM »
Thanks for looking at it, that works great.
Christopher T. Cowgill, P.E.
AEC Collection 2020 (C3D)
Win 10

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Text to Mtext AutoCAD 2015
« Reply #19 on: August 20, 2014, 12:55:46 PM »
Thanks for looking at it, that works great.


Glad to help.  :)  Please test it out a bit, I did not test too thoroughly.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Chris

  • Swamp Rat
  • Posts: 547
Re: Text to Mtext AutoCAD 2015
« Reply #20 on: August 20, 2014, 01:03:25 PM »
will do, I'll let you know if I find any issues.
Christopher T. Cowgill, P.E.
AEC Collection 2020 (C3D)
Win 10

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Text to Mtext AutoCAD 2015
« Reply #21 on: August 27, 2014, 08:29:11 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
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

flyfox1047

  • Guest
Re: Text to Mtext AutoCAD 2015
« Reply #22 on: September 29, 2014, 03:57:36 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.