Topic: txt2mtxt

[PHX cadie]

Because of client standards, they do not allow single text, only mtext. The sub gives us dwgs with all single line text and I have to fix it. I've been using Express tools to convert, but I need to pick each one by one, not group everything into one paragraph.
Van Halen has  great rhythm to hitting the space bar, I can't help but wonder if there is an easier way to convert txt to mtxt?

Thx's

[alanjt]

Quickie...

Code: [Select]

(defun c:Test (/ i ss e)
  (if (setq i  -1
            ss (ssget "_:L" '((0 . "TEXT")))
      )
    (while (setq e (ssname ss (setq i (1+ i)))) (command "_.txt2mtxt" e ""))
  )
  (princ)
)

[ronjonp]

Here's my "homegrown" version: 

Code: [Select]

;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;;
(defun c:t2mt (/  d     doc elst   hgt      lspc n
      nxt  obj     objtxt out   pt      ss txt
      w  x     rjp-removextraspaces  rjp-ent2obj rjp-getbbwdth
      rjp-getbbtlc     rjp-dxf
     )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt)
      (setq txt (vl-string-subst " " "  " 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-getbbwdth (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'car (mapcar 'vlax-safearray->list (list ll ur))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      )
    (progn (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
;;Get widest piece of text to set mtext width
w (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth elst) '>)))
;;Sort text top to bottom
txt (vl-sort
 (mapcar
   '(lambda (x)
      (list
(cadr (rjp-dxf 10 x))
(strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
x
      )
    )
   elst
 )
 (function (lambda (y1 y2) (< (car y2) (car y1))))
)
hgt (rjp-dxf 40 (last (car txt)))
pt (rjp-getbbtlc (last (car txt)))
;;Grab top text to pull properties from
objtxt (vlax-ename->vla-object (last (car txt)))
  )
  ;;Puts hard returns for text spaced greater than (* 2. hgt)
  (setq n 0)
  (foreach x txt
    (if (setq nxt (nth (setq n (1+ n)) txt))
      (if (>= (setq d (abs (- (car x) (car nxt)))) (* 2. hgt))
(setq out (cons (strcat (cadr x) "\\P\\P") out))
(setq out  (cons (cadr x) out)
      lspc (cons d lspc)
)
      )
      (setq out (cons (cadr x) out))
    )
  )
  ;;Join the text into one string
  (setq txt (apply 'strcat (reverse out)))
  ;;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 objtxt))
  (vla-put-attachmentpoint obj actopleft)
  (vlax-put obj 'insertionpoint pt)
  (vla-put-rotation obj 0.0)
  (vla-put-layer obj (vla-get-layer objtxt))
  (vla-put-stylename obj (vla-get-stylename objtxt))
  (if lspc
    (vla-put-linespacingdistance
      obj
      (/ (apply '+ lspc) (length lspc))
    )
  )
  ;;Delete selected single line text
  (mapcar 'entdel elst)
    )
  )
  (princ)
)

[PHX cadie]

You are awesome!

Much Thanks both!!!!!!!!!!

(Knew I should have asked yesterday)

[ronjonp]

Did this code work for you? I forgot to include that a portion of my code removes extra spaces ... if you don't want that, remove the portion in red below:

(strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")

[PHX cadie]

worked great
Thx's ron!

[ronjonp]

Glad to hear

[alanjt]

Nice work Ron. Much better than my simple solution.

[ronjonp]

Thanks Alan 

[cmwade77]

Here's my "homegrown" version: 

Code: [Select]

;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;;
(defun c:t2mt (/  d     doc elst   hgt      lspc n
      nxt  obj     objtxt out   pt      ss txt
      w  x     rjp-removextraspaces  rjp-ent2obj rjp-getbbwdth
      rjp-getbbtlc     rjp-dxf
     )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt)
      (setq txt (vl-string-subst " " "  " 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-getbbwdth (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'car (mapcar 'vlax-safearray->list (list ll ur))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      )
    (progn (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
;;Get widest piece of text to set mtext width
w (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth elst) '>)))
;;Sort text top to bottom
txt (vl-sort
 (mapcar
   '(lambda (x)
      (list
(cadr (rjp-dxf 10 x))
(strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
x
      )
    )
   elst
 )
 (function (lambda (y1 y2) (< (car y2) (car y1))))
)
hgt (rjp-dxf 40 (last (car txt)))
pt (rjp-getbbtlc (last (car txt)))
;;Grab top text to pull properties from
objtxt (vlax-ename->vla-object (last (car txt)))
  )
  ;;Puts hard returns for text spaced greater than (* 2. hgt)
  (setq n 0)
  (foreach x txt
    (if (setq nxt (nth (setq n (1+ n)) txt))
      (if (>= (setq d (abs (- (car x) (car nxt)))) (* 2. hgt))
(setq out (cons (strcat (cadr x) "\\P\\P") out))
(setq out  (cons (cadr x) out)
      lspc (cons d lspc)
)
      )
      (setq out (cons (cadr x) out))
    )
  )
  ;;Join the text into one string
  (setq txt (apply 'strcat (reverse out)))
  ;;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 objtxt))
  (vla-put-attachmentpoint obj actopleft)
  (vlax-put obj 'insertionpoint pt)
  (vla-put-rotation obj 0.0)
  (vla-put-layer obj (vla-get-layer objtxt))
  (vla-put-stylename obj (vla-get-stylename objtxt))
  (if lspc
    (vla-put-linespacingdistance
      obj
      (/ (apply '+ lspc) (length lspc))
    )
  )
  ;;Delete selected single line text
  (mapcar 'entdel elst)
    )
  )
  (princ)
)

This code work great with a routine that I am working on over at http://www.theswamp.org/index.php?topic=35426.0

However, occasionally I need to combine multiple pieces of mtext and this works as long as there is at least on regular piece of text, but I am wondering if there might be a way to modify this to work if the entire selection set is mtext?

[ronjonp]

Just change the filter ... the way it's grabbing text now it should not get any mtext?

(setq ss (ssget ":L" (list '(0 . "*text"))))

or

(setq ss (ssget ":L" (list '(0 . "mtext,text"))))

[cmwade77]

No, sorry, i did modify it to where it will get the mtext already, which is what I want. The problem is that if there is no regular text (i.e. all pieces of text are mtext), then it errors out before finishing the command.

[ronjonp]

No, sorry, i did modify it to where it will get the mtext already, which is what I want. The problem is that if there is no regular text (i.e. all pieces of text are mtext), then it errors out before finishing the command.

Whatever mods you did to the code broke it because I cannot replicate your problem? If you set your VLIDE to break on error you should be able to track down where the code is bonking out.

[cmwade77]

Must remember to restart AutoCAD when things don't quite seem right....I guess something got screwy in a variable during the testing phase, restarted AutoCAD and all seems to be good now, thank you for confirming that your code was not an issue. Sorry about that.

[Robert98]

Here's my "homegrown" version: 

Code: [Select]

;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;;
(defun c:t2mt (/  d     doc elst   hgt      lspc n
      nxt  obj     objtxt out   pt      ss txt
      w  x     rjp-removextraspaces  rjp-ent2obj rjp-getbbwdth
      rjp-getbbtlc     rjp-dxf
     )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt)
      (setq txt (vl-string-subst " " "  " 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-getbbwdth (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'car (mapcar 'vlax-safearray->list (list ll ur))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
      )
    (progn (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
;;Get widest piece of text to set mtext width
w (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth elst) '>)))
;;Sort text top to bottom
txt (vl-sort
 (mapcar
   '(lambda (x)
      (list
(cadr (rjp-dxf 10 x))
(strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
x
      )
    )
   elst
 )
 (function (lambda (y1 y2) (< (car y2) (car y1))))
)
hgt (rjp-dxf 40 (last (car txt)))
pt (rjp-getbbtlc (last (car txt)))
;;Grab top text to pull properties from
objtxt (vlax-ename->vla-object (last (car txt)))
  )
  ;;Puts hard returns for text spaced greater than (* 2. hgt)
  (setq n 0)
  (foreach x txt
    (if (setq nxt (nth (setq n (1+ n)) txt))
      (if (>= (setq d (abs (- (car x) (car nxt)))) (* 2. hgt))
(setq out (cons (strcat (cadr x) "\\P\\P") out))
(setq out  (cons (cadr x) out)
      lspc (cons d lspc)
)
      )
      (setq out (cons (cadr x) out))
    )
  )
  ;;Join the text into one string
  (setq txt (apply 'strcat (reverse out)))
  ;;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 objtxt))
  (vla-put-attachmentpoint obj actopleft)
  (vlax-put obj 'insertionpoint pt)
  (vla-put-rotation obj 0.0)
  (vla-put-layer obj (vla-get-layer objtxt))
  (vla-put-stylename obj (vla-get-stylename objtxt))
  (if lspc
    (vla-put-linespacingdistance
      obj
      (/ (apply '+ lspc) (length lspc))
    )
  )
  ;;Delete selected single line text
  (mapcar 'entdel elst)
    )
  )
  (princ)
)

Hi ronjonp
I made a sample with 12 numbers and run your codes and for selection , I used a fence so your codes act on separate text correctly but put all of them at a column in right side of screen , like this :
145
12
178
10
.
.
.
I don't know , I'm a bad user or your routine  should acts this way . please tell me if I want mtext made instead one of them or at least around them , what must I do ? I don't work whit vlisp codes and most importantly it I need to your permission.
Until after bye :realmad: