Author Topic: mText to Single line mText?  (Read 10972 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
mText to Single line mText?
« on: July 25, 2014, 09:52:00 AM »
A quick search and no luck. I have some mText which I want single lines of text BUT I want the fractions to remain as is.
So Explode doesn't work for me in 2006 as it breaks the lines up where fractions occur.
Has any one seen that routine? Mtext to Mtext as individual lines?
One hurdle I have is that the line spacing is 0.80 so matching the line spacing is a concern too. Although not a big one.

A bonus is a routine that would detect line wrap for those mtext with width > 0 and break at the line wrap.

I have no time today to LISP so I thought I'd ask before diving into it this weekend.  :)
Or just break down & do it by hand.

If no one has the routine don't spend any time over it, I'll get buy.

I'll be out of the office for 6 hours or so.



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.

trogg

  • Bull Frog
  • Posts: 255
Re: mText to Single line mText?
« Reply #1 on: July 25, 2014, 10:34:39 AM »
Here's one from Black Box:

http://forums.augi.com/showthread.php?71721-Multi-line-Mtext-to-Single-line-Mtext

Modified post to remove code since it goes help the CAB's request - sorry Charles
« Last Edit: July 25, 2014, 11:36:00 PM by trogg »

andy_lee

  • Newt
  • Posts: 147
Re: mText to Single line mText?
« Reply #2 on: July 25, 2014, 11:26:24 AM »
Code: [Select]
(defun maketext(ene1 / dat pt str natype txth)
  (setq dat (entget ene1))
  (setq pt (cdr (assoc 10 dat)))
  (setq str (cdr (assoc 1 dat)))
  (setq natype (cdr(assoc 7 dat)))
  (setq txth (cdr(assoc 40 dat)))
  (entmake (list '(0 . "TEXT") (cons 1 str) (cons 10 pt) (cons 8 "hatch") (cons 62 37) (cons 40 txth) (cons 7 natype)))
  (entdel ene1)
  );;;;separation...
andy.
Best regards.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #3 on: July 25, 2014, 01:06:06 PM »
Here's one from Black Box:

http://forums.augi.com/showthread.php?71721-Multi-line-Mtext-to-Single-line-Mtext

That one uses EXPLODE which breaks fractions into separate text & caused the routine to crash.

Thanks
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #4 on: July 25, 2014, 01:12:09 PM »
emk2012, that one returns a plain text object which is not what I was looking for, but thanks for the reply.

Here is the mtext I am working with.
Code: [Select]
  (entmake '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (8 . "zDtl GenNotes") (62 . 6) (100 . "AcDbMText") (10 0.0 0.0 0.0) (40 . 3.0) (41 . 0.0) (71 . 1) (72 . 1)
       (3 . "\\A1; NUMBER AND TYPE \\POF FASTENER {\\H0.7x;\\Sa,b,c/;} \\P\\P3-8d (2{\\H0.7x;\\S1#2;} x0.113\")\\P\\P2-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P2 staples, 1{\\H0.7x;\\S3#4;}\" \\P\\P2-16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P2-16d (3{\\H0.7") (3 . "x;\\S1#2;}\" x0.135\") \\P\\P3-8d or 2-16d \\P(3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P10d (3\" x0.128\") \\P\\P10d (3\" x0.128\") \\P\\P3-16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P8-16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P\\P\\P3-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P \\P8d (2{\\H0.7x;\\S1#") (3 . "2;}\" x0.113\") \\P\\P2-10d (3\" x0.128\") \\P\\P16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P16d (3{\\H0.7x;\\S1#2;}\" x0.135\") \\P\\P3-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P4-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P3-10d (3\" x0.128\") \\P\\P3-10d (3\" x0.128\") \\P\\P2-16d (3{\\H0.7x;\\S1") (3 . "#2;}\" x0.135\") \\P\\P2-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P2 staples, 1{\\H0.7x;\\S3#4;}\" \\P\\P2-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P2 staples, 1{\\H0.7x;\\S3#4;}\" \\P\\P2-8d (2{\\H0.7x;\\S1#2;}\" x0.113\")\\P\\P3 staples, 1{\\H0.7x;\\S3#4;}\" \\P3-8d(2{\\H0.7x;\\S1#2;}\" x0.") (3 . "113\")\\P4 staples, 1{\\H0.7x;\\S3#4;}\"\\P \\P\\P10d (3\" x0.128\") \\P\\P\\P10d (3\" x0.128\") \\P\\P\\P\\P2-16d (3{\\H0.7x;\\S1#2;}\"x0.135\") \\P\\P\\P\\P4-16d (3{\\H0.7x;\\S1#2;}\"x0.135\")\\P\\P3-16d (3{\\H0.7x;\\S1#2;}\" x0.135\")\\P \\P3-8d (2{\\H0.7x;\\S1#2;}\" x0.113\") \\P\\P3-10d (3")
       (1 . "\" x0.128\") ") (7 . "Romans") (11 1.0 0.0 0.0) (42 . 39.37428571428574) (43 . 429.5714285714284) (50 . 0.0) (73 . 1) (44 . 1.0)))
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.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #5 on: July 25, 2014, 04:47:12 PM »
Here's my attempt, as we could use this as well, but you will notice it only works with the first two line for some reason, not sure why:

Code: [Select]
;Explode MText
;Explodes Mtext into single lines of mtext
;Written by: cmwade77 @ theswamp.org - July 2014
;Bug: Currenlty Only works on the first two lines of mtext
;Work Around: Repeat use until all lines are exploded
(defun c:explodemtext (/ *thisdrawing* *modelspace* *paperspace* Ent Object ObjectType Text pt1 style ct OldCt Width txtobj Layer LineCt Pt2 LSpace color)
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object))
      *modelspace*  (vla-get-ModelSpace *thisdrawing*)
  *paperspace*  (vla-get-PaperSpace *thisdrawing*)
)
(setq Ent (nentselp "\rSelect text to explode: "))
(setq Object (vlax-ename->vla-object (car Ent))
  ObjectType (vla-get-ObjectName Object)
)
(if (wcmatch ObjectType "*Text*")
(progn
(setq Text (vla-get-textstring Object)
  pt1 (vla-get-InsertionPoint Object)
  style (vla-get-StyleName Object)
  Width (vla-get-width Object)
  Layer (vla-get-Layer Object)
  LSpace (vla-get-LineSpacingDistance Object)
  pt1 (vlax-safearray->list (vlax-variant-value pt1))
  color (vla-get-color Object)
)
(vla-delete Object)
(setq ct 1)
(setq LineCt 0)
(setq OldCt 1)
(while (<= ct (strlen Text))
(if (= (substr Text ct 2) "\\P")
(progn
(setq pt2 (vlax-3d-point (nth 0 Pt1) (- (nth 1 Pt1) (* LineCt LSPace)) (nth 2 Pt1)))
(setq NewText (substr Text OldCt (+ (- (- ct 1) OldCt) 1))
  OldCt (+ ct 2)
  LineCt (+ LineCt 1)
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq txtobj (vla-AddMtext *modelspace* pt2 width NewText))
(setq txtobj (vla-AddMtext *paperspace* pt2 width NewText))
)
(vla-put-StyleName txtobj Style)
(vla-put-layer txtObj Layer)
(vla-put-color txtObj color)
)
)
(setq ct (+ ct 1))
)
)
)
)

I would also imagine that there are a lot of other properties that need to copy over as well and there are quite possibly better choices for the line spacing.

andy_lee

  • Newt
  • Posts: 147
Re: mText to Single line mText?
« Reply #6 on: July 26, 2014, 01:00:47 AM »
Here's my attempt, as we could use this as well, but you will notice it only works with the first two line for some reason, not sure why:


cmwade77 , Thanks for sharing!

I  publish your question in Chinese forum , and my boss give a answer.You can reference.
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110871&page=1#pid646141
The bug modfiy by: edata  @mjtd.com 2014-7-26

Code: [Select]
;Explode MText
;Explodes Mtext into single lines of mtext
;Written by: cmwade77 @ theswamp.org - July 2014
;Bug: Currenlty Only works on the first two lines of mtext
;Work Around: Repeat use until all lines are exploded
;The bug modfiy by: edata  @mjtd.com 2014-7-26

(defun c:explodemtext (/ *thisdrawing* *modelspace* *paperspace* Ent Object ObjectType Text NEWTEXT pt1 style textlst  Width txtobj Layer LineCt Pt2 LSpace color)
  (vl-load-com)
  (setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object))
        *modelspace*  (vla-get-ModelSpace *thisdrawing*)
      *paperspace*  (vla-get-PaperSpace *thisdrawing*)
  )
  (setq Ent (nentselp "\rSelect text to explode: "))
  (setq Object (vlax-ename->vla-object (car Ent))
      ObjectType (vla-get-ObjectName Object)
  )
  (if (wcmatch ObjectType "*Text*")
    (progn
      (setq Text (vla-get-textstring Object)
          pt1 (vla-get-InsertionPoint Object)
          style (vla-get-StyleName Object)
          Width (vla-get-width Object)
          Layer (vla-get-Layer Object)
          LSpace (vla-get-LineSpacingDistance Object)
          pt1 (vlax-safearray->list (vlax-variant-value pt1))
          color (vla-get-color Object)
      )
      (vla-delete Object)     
      (setq LineCt 0)           
      (setq textlst(parse12 Text "\\P"))     
      (while (setq NewText(car textlst))
        (setq pt2 (vlax-3d-point (nth 0 Pt1) (- (nth 1 Pt1) (* LineCt LSPace)) (nth 2 Pt1))
              LineCt (+ LineCt 1))
        (if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
              (setq txtobj (vla-AddMtext *modelspace* pt2 width NewText))
              (setq txtobj (vla-AddMtext *paperspace* pt2 width NewText))
            )
            (vla-put-StyleName txtobj Style)
            (vla-put-layer txtObj Layer)
            (vla-put-color txtObj color)
        (setq textlst(cdr textlst))
        )
    )
  )
)
;;string delimiter
;;code By st788796
(defun parse12 (str delimiter / POST STRL STRLST)
  (setq strl (strlen delimiter))
  (while (vl-string-search delimiter str)
    (setq post (vl-string-search delimiter str))
    (setq strlst (append strlst (list (substr str 1 post))))
    (setq str (substr str (+ post (1+ strl))))
  )
  (vl-remove "" (append strlst (list str)))
)
andy.
Best regards.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #7 on: July 26, 2014, 12:07:00 PM »
This is what I have so far, does not make adjustments for line spacing when danglers are present or word wrap when width > 0.
Check out Tim's lisp here http://www.theswamp.org/index.php?topic=29430.0 for some ideas on line spacing.
I will work on that as time permits but for now it works. 8)

PS Only works properly for TopLeft, TopCenter & TopRight.
Others still work but group of new text will need to be moved.


Code removed for update.
« Last Edit: July 27, 2014, 12:05:18 AM by CAB »
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #8 on: July 27, 2014, 12:06:07 AM »
New code, still has some short comings.
<Edit: code updated>
Code: [Select]
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +              Mtext to Mtext Lines                      +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2014                           +
;;;       +           Contact CAB at TheSwamp.org                  +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

;;  Creates Mtext single lines from Multiple lines of mtext delimited with //P
;;  Still a work in progress
;;  Will not deal with wrapped Mtext
;;  Will not deal with Formatting code that continues into the next line.
;;  Will not deal with lines with varying heights and set to "At Least" Line spacing

(defun c:mt2mt (/ e) ; by CAB
  (while (setq e (car (entsel "\nPick Mtext to make single lines of Mtext.")))
    (cond
      ((= (cdr (assoc 0 (entget e))) "MTEXT")
       (MtextBreak (vlax-ename->vla-object e))
      )
      (t (princ "\nERROR  ---> Not an Mtext Object.  Try Again."))
    )
  )
  (princ)
)


;  parser by CAB multi char delim, match "xyz"
(defun sparser (str delim / dlen ptr lst)
  (setq dlen (1+ (strlen delim)))
  (while (setq ptr (vl-string-search delim str))
    (setq lst (cons (substr str 1 ptr) lst))
    (setq str (substr str (+ ptr dlen)))
  )
  (reverse(cons str lst))
)



;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +                  box_mtext                             +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +           Contact CAB at TheSwamp.org                  +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; VERSION
;;;  1.2 Jan 24, 2006  UCS corrections
;;;
;;; FUNCTION
;;;  Return Box coordinates for an Mtext object in any UCS, any angle.
;;;
;;; USAGE
;;;  (box_mtext ent)
;;;
;;; ARGUMENTS
;;;  ent = mtext ename
;;;
;;;  RETURNS
;;;   list of 4 points for box,  (ll lr ur ul)
;;;
;;; PLATFORMS
;;;  2000+ Tested in 2000 only
(defun box_mtext (ent / elst p10 txth ang vec wid hgt dxf UCSangle
                  attpt ul ur lr ll)
  (defun dxf (code elst)
    (cdr (assoc code elst))
  )

  ;; incase it is a list,  (ename point)
  (and (listp ent) (setq ent (car ent)))
  (setq elst (entget ent))

  (setq p10   (trans (dxf 10 elst) 0 1) ; insertion point WCS to UCS
        txth  (dxf 40 elst) ; text height
        wid   (dxf 42 elst) ; full width
        hgt   (dxf 43 elst) ; full height
        ang   (dxf 50 elst) ; rotation angle in UCS
        attpt (dxf 71 elst) ; attachment point code
  )

  ;|--------------------------------------------------------------
  ;;  CAB 01/24/2006 removed as the ang fron DXF code 50 os in UCS
  ;;  correct for UCS
  (setq  ang (- ang (angle (trans '(0.0 0.0 0.0) 1 0)
                           (trans '(1.0 0.0 0.0) 1 0)))
  )
  ;;  angles  90 = (/ pi 2)   180 = pi  270 = (* pi 1.5)
  ---------------------------------------------------------------|;

 
  ;;  Get upper left (ul) from insert point (p10)
  (cond ((= attpt 1) (setq ul p10)) ; top left
        ((= attpt 2) (setq ul (polar p10 (+ pi ang) (/ wid 2)))) ; top center
        ((= attpt 3) (setq ul(polar p10 (+ pi ang) wid))) ; top right
        ((= attpt 4) (setq ul (polar p10 (+ (/ pi 2) ang) (/ hgt 2)))) ; middle left
        ((= attpt 5) ; middle center
         (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
        ((= attpt 6) ; middle right
         (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
        ((= attpt 7) (setq ul (polar p10 (+(/ pi 2) ang) hgt))) ; bottom left
        ((= attpt ; bottom center
         (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) hgt)))
        ((= attpt 9) ; bottom right
         (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) hgt)))
  );cond
  (setq ur (polar ul ang wid)
        lr (polar ur (+ ang (* pi 1.5)) hgt)
        ll (polar lr (+ ang pi) wid)
  );setq
  (list ll lr ur ul)
);boxmtext







(defun MtextBreak (mtObj / DXFX ENT ENTL INSPT LST MTATTPT MTINSPT MTLNSPC MTOBJ
                     MTROT MTSTR MTWD TEMPSTR TXOBJLIST)

  ;---------------------------------------------------------------

  (setq mtwd    (vla-get-width mtobj)
        mtrot   (vla-get-rotation mtobj)
        mtlnspc (vla-get-linespacingdistance mtobj)
        mtattpt (vla-get-attachmentpoint mtobj) ; attachmnebt like TopLeft
        mtinspt (vla-get-insertionpoint mtobj) ; 3d point
        mtlnspc (vla-get-linespacingdistance mtobj)
        mtlnsps (vla-get-LineSpacingStyle mtobj) ; At Least = 1 ; Exactly = 2
  )


  ;;-----------------------------------------------------------
  ;;  Get dxf codes needed for new mText to match parent mText
  ;;-----------------------------------------------------------
  ;; return value from a dotted pair
  (defun dxf (x data) (cdr (assoc x data)))
  (setq entl (entget (vlax-vla-object->ename mtobj))
        dxfx '(-2 -1 5 102 300 330 331 340 350 360 410 3)
        entl (vl-remove-if '(lambda (pair) (member (car pair) dxfx)) entl)
  )
  ;;-----------------------------------------------------
 

  ;;  Get height of BB  Not used yet !!
  (defun getheight (entl str / entlt entt ll ur lspc)
    ;;  make test mtext to get height of BB
    (setq entl (subst (cons 1 str) (assoc 1 entl) entl))
    (setq entt (entmakex (subst (list 10 0 0 0) (assoc 10 entl) entl))) ; update insertion point
    (vla-getboundingbox (vlax-ename->vla-object entt) 'll 'ur)
    (setq ll (safearray-value ll))
    (setq ur (safearray-value ur))
    (setq lspc (abs (- (cadr ll) (cadr ur))))
    (entdel entt)
    lspc
  )
 
  (setq mtrot (+ (* pi 1.5) mtrot)) ; +270 deg, direction to offset new mtext


  ;;  Get the string & seperate it by CR or "\\P"
  (setq tempstr (setq mtstr (vla-get-textstring mtobj)))
  (setq lst (sparser tempstr "\\P")) ; list of each line of text
 
 
  ;;  Deal with Other than Top L C R attachment Points
  ;;  stradigy; create new mtext from top down so top is ok to use as is
  ;;  others need to find the top of the BB of original mtext then offset
  ;;  down to correct position for first text object then all others should
  ;;  be aligned correctily
 
  (setq ent (vlax-vla-object->ename mtobj))
  (cond
    ((vl-position mtattpt '(1 2 3))
     (setq inspt (cdr (assoc 10 entl)))) ; Top - temp point, no adjustment needed
   
    ((vl-position mtattpt '(4 5 6))    ; Middle - adjust starting point
     (setq plst (box_mtext ent))    ; for original mtext '(ll lr ur ul)
     (setq h (getheight entl (car lst))) ; get height of 1st string
     (cond
       ((= mtattpt 4) ; acAttachmentPointMiddleLeft
        (setq inspt (polar (last plst) (angle (last plst) (car plst)) (/ h 2))))
       ((= mtattpt 5) ; acAttachmentPointMiddleCenter
        (setq um (polar (last plst) (angle (last plst)(caddr plst)) (/ (distance (last plst)(caddr plst)) 2)))
        (setq inspt (polar um (angle (last plst) (car plst)) (/ h 2))))
       ((= mtattpt 6) ; acAttachmentPointMiddleRight
        (setq inspt (polar (caddr plst) (angle (last plst) (car plst)) (/ h 2))))
      )
     )
       
    ((vl-position mtattpt '(7 8 9))    ; Bottom - adjust starting point
     (setq plst (box_mtext ent))
     (setq h (getheight entl (car lst))) ; get height of 1st string
     (cond
       ((= mtattpt 7) ;acAttachmentPointBottomLeft
        (setq inspt (polar (last plst) (angle (last plst) (car plst)) h)))
       ((= mtattpt ; acAttachmentPointBottomCenter
        (setq um (polar (last plst) (angle (last plst)(caddr plst)) (/ (distance (last plst)(caddr plst)) 2)))
        (setq inspt (polar um (angle (last plst) (car plst)) h)))
       ((= mtattpt 9) ; acAttachmentPointBottomRight
        (setq inspt (polar (caddr plst) (angle (last plst) (car plst)) h)))
      )
     )
       
  )

  (foreach str lst
    (if (/= "" (vl-string-trim " \t\n" str))
      (progn
        (setq entl (subst (cons 10 inspt) (assoc 10 entl) entl)) ; update insertion point
        (setq ent (entmakex (subst (cons 1 str) (assoc 1 entl) entl))) ; update string
      )
    )

    (setq inspt (polar inspt mtrot mtlnspc))
  )
  (princ "\nMtext Converted to Mtext Line by Line.")
)
« Last Edit: July 28, 2014, 08:41:14 AM by CAB »
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.

andy_lee

  • Newt
  • Posts: 147
Re: mText to Single line mText?
« Reply #9 on: July 27, 2014, 08:26:55 PM »
New code, still has some short comings.

when appload, display "error: malformed list on input"  but still can run command.  when choose mtext, display"error: no function definition: MTEXTBREAK"
« Last Edit: July 28, 2014, 12:11:59 AM by CAB »
andy.
Best regards.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #10 on: July 28, 2014, 12:13:01 AM »
Sorry for the cut & Paste error, so I posted newer code. Hope it is correct this time.
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.

andy_lee

  • Newt
  • Posts: 147
Re: mText to Single line mText?
« Reply #11 on: July 28, 2014, 02:15:21 AM »
Sorry for the cut & Paste error, so I posted newer code. Hope it is correct this time.

Lack of function : STR->LST

Code: [Select]
;; by gile
(defun str->lst (txtstr delim / pos)
  (if (setq pos (vl-string-search delim txtstr))
    (cons (substr txtstr 1 pos)
          (str->lst (substr txtstr (+ (strlen delim) pos 1)) delim)
    )
    (list txtstr)
  )
)
« Last Edit: July 28, 2014, 02:28:45 AM by emk2012 »
andy.
Best regards.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #12 on: July 28, 2014, 08:42:30 AM »
Sorry again, I replaced gile's function with mine & forgot to update the call.
Code is updated again & should work.

Thanks for testing  8)
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.

andy_lee

  • Newt
  • Posts: 147
Re: mText to Single line mText?
« Reply #13 on: July 28, 2014, 10:32:39 AM »
Sorry again, I replaced gile's function with mine & forgot to update the call.
Code is updated again & should work.

Thanks for testing  8)

when appload , Command: ; error: malformed list on input
andy.
Best regards.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #14 on: July 28, 2014, 01:04:08 PM »

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #15 on: July 28, 2014, 01:31:41 PM »
Here's my attempt, as we could use this as well, but you will notice it only works with the first two line for some reason, not sure why:


cmwade77 , Thanks for sharing!

I  publish your question in Chinese forum , and my boss give a answer.You can reference.
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110871&page=1#pid646141
The bug modfiy by: edata  @mjtd.com 2014-7-26


Thank you, also I found a slight bug in your code, any text after a blank line would not remain in the correct spot.

This is my corrected code, also this code will now copy all properties, as it simply makes a copy of the text and modifies it instead.

Code: [Select]
;Explode MText
;Explodes Mtext into single lines of mtext
;Written by: cmwade77 @ theswamp.org - July 2014
;Bug: Currenlty Only works on the first two lines of mtext
;Work Around: Repeat use until all lines are exploded
;Bug Fix by: edata  @mjtd.com 2014-7-26

(defun c:explodemtext (/ SS Ent Object ObjectType Text NEWTEXT pt1 textlst txtobj LineCt Pt2 LSpace rot)
(defun Degrees->Radians (numberOfDegrees)
  (* pi (/ numberOfDegrees 180.0))
)
  (vl-load-com)
  (while (= SS nil)
(princ "\rSelect MText to explode: ")
(setq Filter '((0 . "MTEXT"))
  SS (ssget Filter)
)
  )
  ((lambda (i / Ent)
(while (setq Ent (ssname SS (setq i (1+ i))))
(setq Object (vlax-ename->vla-object Ent)
  ObjectType (vla-get-ObjectName Object)
)

(setq Text (vla-get-textstring Object)
    pt1 (vla-get-InsertionPoint Object)
    LSpace (vla-get-LineSpacingDistance Object)
    pt1 (trans (vlax-safearray->list (vlax-variant-value pt1)) 0 1)
    rot (vla-get-rotation Object)
)     
(setq LineCt 0)           
(setq textlst(parse12 Text "\\P"))     
(while (setq NewText(car textlst))
  (setq pt2 (trans (polar pt1 (- rot (Degrees->Radians 90.0)) (* LineCt LSPace)) 1 0)
        pt2 (vlax-3d-point pt2)
        LineCt (+ LineCt 1))
  (setq txtobj (vla-copy Object))
  (vla-put-textstring txtObj NewText)
  (vla-put-InsertionPoint txtObj pt2)
  (setq textlst(cdr textlst))
)
(vla-delete Object)
)
    )
-1)
 
)
;;string delimiter
;;code By st788796
(defun parse12 (str delimiter / POST STRL STRLST)
  (setq strl (strlen delimiter))
  (while (vl-string-search delimiter str)
    (setq post (vl-string-search delimiter str))
    (setq strlst (append strlst (list (substr str 1 post))))
    (setq str (substr str (+ post (1+ strl))))
  )
  (append strlst (list str));Code modified by cmwade77 to allow text after blanks lines to remain in place.
)

This should also account for all possible alignments and should work more reliably with versions older than 2009, as there were some properties that may not have been available.

NOTE: For those that have AutoCAD 2015, if the piece of mText was created in AutoCAD 2015, it will explode correctly with the normal explode command; however, if the text was created in 2014 or earlier, the mText will explode as CAB has described in his first post and one of the routines posted here is needed.

EDIT: Fixed problem with the code that was posted.

EDIT: Changed code to allow for rotated text, rotated UCS and to allow selecting multiple pieces of text.
« Last Edit: July 28, 2014, 04:53:26 PM by cmwade77 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #16 on: July 28, 2014, 01:43:40 PM »
How about the one from this post:
http://www.theswamp.org/index.php?topic=29430.msg463814#msg463814

They all return plain text objects, I wanted Single individual objects by lines of Mtext.
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #17 on: July 28, 2014, 01:48:17 PM »
Sorry again, I replaced gile's function with mine & forgot to update the call.
Code is updated again & should work.

Thanks for testing  8)

when appload , Command: ; error: malformed list on input

I copy & pasted from forum without error.
Perhaps the file attached will work for you.
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.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #18 on: July 28, 2014, 01:52:46 PM »
How about the one from this post:
http://www.theswamp.org/index.php?topic=29430.msg463814#msg463814

They all return plain text objects, I wanted Single individual objects by lines of Mtext.
Yeah, but if you wanted the wrapped text to be accounted for, I thought it might be a good starting place. In my case I don't really care about the wrapped text, so what I posted a little bit ago works as well.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #19 on: July 28, 2014, 01:56:01 PM »
Thank you, also I found a slight bug in your code, any text after a blank line would not remain in the correct spot.

This is my corrected code, also this code will now copy all properties, as it simply makes a copy of the text and modifies it instead.

No problem with my code here in ADAC2004, blank lines work fine.

Your code produces plain text not Mtext that I desire.

Thanks
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #20 on: July 28, 2014, 01:57:57 PM »
How about the one from this post:
http://www.theswamp.org/index.php?topic=29430.msg463814#msg463814

They all return plain text objects, I wanted Single individual objects by lines of Mtext.
Yeah, but if you wanted the wrapped text to be accounted for, I thought it might be a good starting place. In my case I don't really care about the wrapped text, so what I posted a little bit ago works as well.

My priority is to maintain formatting of fractions! Word wrap is not an issue it is just something that would be nice to add to the code for future users.

Thanks
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.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #21 on: July 28, 2014, 02:07:22 PM »
Thank you, also I found a slight bug in your code, any text after a blank line would not remain in the correct spot.

This is my corrected code, also this code will now copy all properties, as it simply makes a copy of the text and modifies it instead.

No problem with my code here in ADAC2004, blank lines work fine.

Your code produces plain text not Mtext that I desire.

Thanks
Huh? It produced Mtext for me. Literally, all I do is copy the mText that you are exploding, changing the text and insertion point. So there is no reason (as long as mText is selected) that it shouldn't produce mText.

I have attached a sample of what I get, perhaps you could attach something similar? I just don't understand how it's producing plain text and want to figure that out.

I would appreciate the help, as I really don't understand what is going on here. Also, the bug I mentioned was not in your code, but in the bug fix that emk2012 provided for my original code.

I unfortunately have not been able to get your code to run on 2015 yet.

Also, please try the code from http://www.theswamp.org/index.php?topic=47467.msg524898#msg524898 again, as I did find an error in what I posted.
« Last Edit: July 28, 2014, 02:23:27 PM by cmwade77 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #22 on: July 28, 2014, 02:54:27 PM »
OK that code did work as long as the UCS or the mtext is not rotated.

Thanks
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.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #23 on: July 28, 2014, 02:58:15 PM »
OK that code did work as long as the UCS or the mtext is not rotated.

Thanks

Ok, just making sure, that was the next item to look at, but I had to make sure the basics worked first.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #24 on: July 28, 2014, 04:54:36 PM »
OK that code did work as long as the UCS or the mtext is not rotated.

Thanks

Please try the code again, I have modified it to work with rotated text, rotated UCS and to be able to select multiple pieces of mtext at once, filtering out any non-mtext entities.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: mText to Single line mText?
« Reply #25 on: July 29, 2014, 03:00:30 PM »
Here's another one that will let you adjust the text spacing to match the source text.
Code: [Select]
(defun c:mtbreak (/ *error* _blank _foo _parse a co d e gr i inc l lines lsd o p x)
  (vl-load-com)
  (defun *error* (msg)
    (and l (mapcar '(lambda (x) (vl-catch-all-apply 'vla-delete (list x))) l))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (defun _parse (s / p)
    (if (setq p (vl-string-search "\\P" s))
      (cons (substr s 1 p) (_parse (substr s (+ p 1 (strlen "\\P")))))
      (list s)
    )
  )
  (defun _blank (s)
    (and s (or (null (vl-string->list s)) (vl-every '(lambda (x) (= x 32)) (vl-string->list s))))
  )
  (if (and (setq e (car (entsel "\nPick MTEXT: ")))
   (setq o (vlax-ename->vla-object e))
   (= (vla-get-objectname o) "AcDbMText")
   (> (length (setq lines (_parse (vla-get-textstring o)))) 1)
      )
    (progn
      (setq p (vlax-get o 'insertionpoint))
      (setq a (- (vla-get-rotation o) (/ pi 2.)))
      (setq lsd (vla-get-linespacingdistance o))
      (setq d 0)
      (foreach line lines
(if (_blank line)
  (setq d (+ d lsd))
  (progn (setq l (cons (setq co (vla-copy o)) l))
(vla-put-textstring co line)
(vlax-put co 'insertionpoint (polar p a d))
(setq d (+ d lsd))
  )
)
      )
      (vla-put-color o 1)
      (setq i 1)
      (setq inc 0.0001)
      (alert "Press 'A' or 'S' to Adjust Text Spacing, Any other key to Exit...")
      (while (or (= 5 (car (setq gr (grread t 4 1))))
(and (= 2 (car gr)) (member (cadr gr) '(65 97 83 115)))
     )
(if (= 2 (car gr))
  (progn (cond ((member (cadr gr) '(65 97)) (setq i (- i inc)))
       ((member (cadr gr) '(83 115)) (setq i (+ i inc)))
)
(and (<= i 0) (setq i 1))
(mapcar '(lambda (x)
    (vlax-put x
      'insertionpoint
      (polar p a (* i (distance p (vlax-get x 'insertionpoint))))
    )
  )
l
)
(mapcar 'vla-update l)
  )
)
;; (princ (strcat "\n" (vl-prin1-to-string gr)))
(princ "\rPress 'A' or 'S' to Adjust Text Spacing, Any other key to Exit...")
      )
      (vla-delete o)
    )
  )
  (princ)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: mText to Single line mText?
« Reply #26 on: July 29, 2014, 04:42:44 PM »
Isn't that special.  8)

Nice job Ron and like the vla-copy  :)

The issue with ACAD2006 is that the spacing varies from line to line due to fractions etc. but that is close.
It does not account for Middle or Bottom insert points.
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.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: mText to Single line mText?
« Reply #27 on: July 29, 2014, 07:03:45 PM »
Isn't that special.  8)

Nice job Ron and like the vla-copy  :)

The issue with ACAD2006 is that the spacing varies from line to line due to fractions etc. but that is close.
It does not account for Middle or Bottom insert points.


Thanks Charles. I tried to get the "true" height of each text line but proved difficult with mtext format ( {}\ etc.. ). The grread version was more of a hack, but still faster than doing it manually  8) . If I get some time, I'll try to adjust for varying insertion points.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #28 on: July 29, 2014, 07:37:40 PM »
Isn't that special.  8)

Nice job Ron and like the vla-copy  :)

The issue with ACAD2006 is that the spacing varies from line to line due to fractions etc. but that is close.
It does not account for Middle or Bottom insert points.


Thanks Charles. I tried to get the "true" height of each text line but proved difficult with mtext format ( {}\ etc.. ). The grread version was more of a hack, but still faster than doing it manually  8) . If I get some time, I'll try to adjust for varying insertion points.
I need to dust off my older hard drives, I know I have some very old code laying around that I used to use to get the true height of each line of text.

Here's the basics of how it worked:
  • Get bounding box of mtext
  • Make a copy of the Mtext and freeze it
  • Explode the MText
  • Get the bounding box for each line of text and process accordingly
  • Erase the individual pieces of text
  • Thaw the mText copy and move it back to the original layer
This is a bit of over simplification, but it gives the gist.

I had originally used it for inserting number bubbles for reference notes; however, I have since found ways of doing so without exploding the text. But I would imagine that this method could be adapted to the purpose of this discussion.
« Last Edit: July 29, 2014, 07:42:09 PM by cmwade77 »

77077

  • Guest
Re: mText to Single line mText?
« Reply #29 on: September 28, 2014, 08:47:27 PM »
Nice routine ,ronjonp .

ronjonp

  • Needs a day job
  • Posts: 7526
Re: mText to Single line mText?
« Reply #30 on: September 29, 2014, 09:03:26 AM »
Thanks  :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

hmspe

  • Bull Frog
  • Posts: 362
Re: mText to Single line mText?
« Reply #31 on: September 29, 2014, 05:57:18 PM »
I use this to get line spacing.

Code: [Select]
;;; determine line spacing for a text style
(defun enco_line_space (t_style t_height / text_style text_height dot1 dot1_entity dot2 dot2_entity spacing)
  (if (= t_style "")
    (setq text_style (getvar "textstyle"))                                                          ; get the current text style
    (setq text_style t_style)
  )
  (if (= t_height "")
    (setq text_height (getvar "textsize"))                                                          ; get the current text height
    (setq text_height t_height)
  )
  (entmake
    (list
      (cons 0 "MTEXT")                                                                              ; Entity Type
      (cons 100 "AcDbEntity")                                                                       ; 100 Entity Code
      (cons 100 "AcDbMText")                                                                        ; 100 Entity Code
      (cons 7 text_style)
      (cons 8 "0")
      (cons 40 text_height)
      (cons 1 ".")
      (cons 1 "\n.")
      (cons 10 '(0.0 0.0 0.0))                                                                      ; Insertion Point
    )
  )
  (command "explode" "last")
  (setq dot1 (entlast))                                                                             ; get the entity
  (setq dot1_entity (entget dot1))                                                                  ; get the entity's data
  (entdel dot1)                                                                                     ; get rid of the evidence
  (setq dot2 (entlast))                                                                             ; get the entity
  (setq dot2_entity (entget dot2))                                                                  ; get the entity's data
  (entdel dot2)

  (setq dot1 (caddr (assoc 10 dot1_entity)))
  (setq dot2 (caddr (assoc 10 dot2_entity)))
  (setq spacing (- (caddr (assoc 10 dot2_entity)) (caddr (assoc 10 dot1_entity))))
  spacing
)
"Science is the belief in the ignorance of experts." - Richard Feynman

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: mText to Single line mText?
« Reply #32 on: September 29, 2014, 06:04:11 PM »
I use this to get line spacing.

Code: [Select]
;;; determine line spacing for a text style
(defun enco_line_space (t_style t_height / text_style text_height dot1 dot1_entity dot2 dot2_entity spacing)
  (if (= t_style "")
    (setq text_style (getvar "textstyle"))                                                          ; get the current text style
    (setq text_style t_style)
  )
  (if (= t_height "")
    (setq text_height (getvar "textsize"))                                                          ; get the current text height
    (setq text_height t_height)
  )
  (entmake
    (list
      (cons 0 "MTEXT")                                                                              ; Entity Type
      (cons 100 "AcDbEntity")                                                                       ; 100 Entity Code
      (cons 100 "AcDbMText")                                                                        ; 100 Entity Code
      (cons 7 text_style)
      (cons 8 "0")
      (cons 40 text_height)
      (cons 1 ".")
      (cons 1 "\n.")
      (cons 10 '(0.0 0.0 0.0))                                                                      ; Insertion Point
    )
  )
  (command "explode" "last")
  (setq dot1 (entlast))                                                                             ; get the entity
  (setq dot1_entity (entget dot1))                                                                  ; get the entity's data
  (entdel dot1)                                                                                     ; get rid of the evidence
  (setq dot2 (entlast))                                                                             ; get the entity
  (setq dot2_entity (entget dot2))                                                                  ; get the entity's data
  (entdel dot2)

  (setq dot1 (caddr (assoc 10 dot1_entity)))
  (setq dot2 (caddr (assoc 10 dot2_entity)))
  (setq spacing (- (caddr (assoc 10 dot2_entity)) (caddr (assoc 10 dot1_entity))))
  spacing
)
Yes, that is what I used to use (or something very similar), but couldn't find any copies of it anywhere.