Update available to text to mtext lisp?

Update available to text to mtext lisp?

nbawden
Advocate Advocate
3,239 Views
2 Replies
Message 1 of 3

Update available to text to mtext lisp?

nbawden
Advocate
Advocate

A great lisp was posted in the following thread a while back:

 

http://forums.autodesk.com/t5/autocad-2007-2008-2009/converting-text-to-mtext/td-p/2296453/page/2

 

The lisp allows you to convert a group of text objects into individual mtext objects unlike the standard express tools txt2mtxt which combines into a single mtext entity. The code is posted below. I have discovered one small "flaw". It won't allow attributes to be converted to mtext whereas txt2mtxt does. Does anyone have an updated copy that caters for attributes or know how to tweak the code to allow it?

 

;;  Text1MtextJust.lsp [command name: T1MJ]

;;  TXT2MTXT command does not preserve all aspects of justification.  For
;;    one selected Text entity, retains horizontal component [except Aligned/
;;    Fit have Center imposed], but imposes Top for vertical component to
;;    all, regardless of Text entity's original justification.
;;  T1MJ converts each selected Text entity separately to Mtext with same or
;;    equivalent justification as original Text, including vertical component.
;;  "Equivalent" for Text-entity justifications not used with Mtext:
;;    Left/Center/Right become Bottom-Left/Bottom-Center/Bottom-Right;
;;    Middle becomes Middle-Center;
;;    Aligned/Fit become Bottom-Center with new insertion point half-way
;;      between original Text entity's baseline alignment/fit points, so that
;;      any positional change is minimized.
;;  Will sometimes result in slight positional change, depending on specific
;;    justification involved, text font, and/or whether text content includes
;;    characters extending above or below height of capital letters [e.g. lower-
;;    case letters with descenders, parentheses/brackets/braces, slashes, etc.].
;;  Fit-justified Text will retain original height, but lose width adjustment.
;;  Kent Cooper, 18 February 2014

(defun C:T1MJ ; = Text to 1-line Mtext, retaining Justification
  (/ *error* cmde tss inc tent tobj tins tjust)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (command "_.undo" "_end")
    (setvar 'cmdecho cmde)
    (princ)
  ); defun - *error*

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")
  (prompt "\nTo change Text to 1-line Mtext, preserving Justification,")
  (if (setq tss (ssget "_:L" '((0 . "TEXT"))))
    (repeat (setq inc (sslength tss))
      (setq
        tent (ssname tss (setq inc (1- inc)))
        tobj (vlax-ename->vla-object tent)
        tins (vlax-get tobj 'TextAlignmentPoint)
        tjust (vla-get-Alignment tobj)
      ); setq
      (cond
        ((= tjust 0) (setq tjust 7 tins (vlax-get tobj 'InsertionPoint))); Left
        ((< tjust 3) (setq tjust (+ tjust 7))); 1/2 [Center/Right] to 7/8/9
        ((= tjust 4) (setq tjust 5)); Middle to Middle-Center
        ((member tjust '(3 5)); Aligned/Fit
          (setq
            tjust 8 ; to Bottom-Center
            tins (mapcar '/ (mapcar '+ (vlax-get tobj 'InsertionPoint) tins) '(2 2 2))
              ; with new insertion point
          ); setq
        ); Aligned/Fit
        ((setq tjust (- tjust 5))); all vertical-horizontal pair justifications
      ); cond
      (command "_.txt2mtxt" tent ""); convert, then
      (setq tobj (vlax-ename->vla-object (entlast))); replace Text with new Mtext
      (vla-put-AttachmentPoint tobj tjust); original Text's justification [or equiv.]
      (vlax-put tobj 'InsertionPoint tins); original Text's insertion
    ); repeat
  ); if
  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); defun -- T1MJ
(vl-load-com)
(prompt "\nType T1MJ to change Text to 1-line Mtext, preserving Justification.")

 

0 Likes
Accepted solutions (1)
3,240 Views
2 Replies
Replies (2)
Message 2 of 3

Kent1Cooper
Consultant
Consultant
Accepted solution

@nbawden wrote:

A great lisp was posted .... 

The lisp allows you to convert a group of text objects into individual mtext objects unlike the standard express tools txt2mtxt which combines into a single mtext entity. .... I have discovered one small "flaw". It won't allow attributes to be converted to mtext whereas txt2mtxt does. Does anyone have an updated copy that caters for attributes or know how to tweak the code to allow it? 


I made the adjustment in the attached updated Text1MtextJust.lsp.  It wasn't very complicated, since the VLA Properties of ATTDEF objects are essentially the same as for TEXT entities except for the entity type [ObjectName].  I found that if an Attribute Definition has no default value, TXT2MTXT makes it disappear, since it imposes its empty TextString value [""], so T1MJ includes imposing the Tag value for a Text value -- it has instructions to change that to the Prompt value if you prefer.  I also changed the Undo begin/end aspects so that it doesn't use (command) in the *error* handler as the earlier one did, since 2015 doesn't like you to do that any more.  Lightly tested.

Kent Cooper, AIA
Message 3 of 3

nbawden
Advocate
Advocate

Perfect - thank you !!

0 Likes