Author Topic: Exploding mtext to keep same justification for regular text  (Read 4375 times)

0 Members and 1 Guest are viewing this topic.

notredave

  • Newt
  • Posts: 140
Exploding mtext to keep same justification for regular text
« on: September 16, 2019, 11:37:25 AM »
Good morning all,

I am looking for a lisp routine that will explode or another way to change mtext to regular text keeping justification of existing mtext. I have several drawings that we used as go-by's but client cad standards does not allow mtext for some reason. I have middle center, middle left, middle right and bottom center justified mtext that i would like to keep the same justification for regular text. If anyone has seen such a lisp, please share it with me. I would greatly appreciate it.

Thank you in advance,
David

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #1 on: September 16, 2019, 11:43:16 AM »
Attaching example drawing....

Dlanor

  • Bull Frog
  • Posts: 263
Re: Exploding mtext to keep same justification for regular text
« Reply #2 on: September 16, 2019, 02:14:13 PM »
This should find and explode all MText in the drawing if thats what you're after.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:x_mt ( / ss)
  2.   (setq ss (ssget "_X" '((0 . "MTEXT"))))
  3.   (setvar 'qaflags 1)
  4.   (command "explode" ss "")
  5.   (setvar 'qaflags 0)
  6. )
  7.  

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #3 on: September 16, 2019, 02:26:44 PM »
Dlanor,

Thank you for your input. That did indeed explode all my mtext but it changed all all my justification to bottom left. I would like to keep justification of mtext as it currently is.

David

Dlanor

  • Bull Frog
  • Posts: 263
Re: Exploding mtext to keep same justification for regular text
« Reply #4 on: September 16, 2019, 02:49:26 PM »
Sorry I'm missing something obvious, but I can't open your drawing as it's in a later version that the one I run (2012)  :crazy2:

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #5 on: September 16, 2019, 03:01:59 PM »
saved it down to 2010

Dlanor

  • Bull Frog
  • Posts: 263
Re: Exploding mtext to keep same justification for regular text
« Reply #6 on: September 16, 2019, 08:07:10 PM »
I'll take a look, but be aware that MText alignment points don't translate directly into Text alignment points.

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Exploding mtext to keep same justification for regular text
« Reply #7 on: September 17, 2019, 11:04:44 AM »
Give this a try. You may have a different way you wish to interpret the justification from MTEXT to TEXT.

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun C:MT2T (/ ss ent cnt obj ss2 ent2 cnt2 obj2 mtap just le oldip
  3.                  oldap newip di ag newap _GetTextAlignment _MarkLastEnt
  4.                  _Buildss _error)
  5.  
  6.    ; Error Handler sub-function
  7.    (defun _error (msg)
  8.         (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
  9.           (princ (strcat "\nError: " msg "\n"))
  10.         (princ "\nProgram Aborted.\n")
  11.       )
  12.       (while (not (equal (getvar "cmdnames") ""))(command-s))
  13.       (redraw)(gc)
  14.       (and err-bak (setq *error* err-bak))
  15.       (if (and (not (equal *error* _error)) (not (eq (type *error*) 'SUBR)))
  16.          (*error* msg)
  17.       )
  18.         (princ)
  19.    ); end sub-function
  20.  
  21.    ; sub-function "_MarkLastEnt"
  22.    ; Marks the last entity in the drawing. Makes sure sub-entities are cycled and
  23.    ; prevents error in blank drawing by making a marker entity.
  24.    (defun _MarkLastEnt (/ e en)
  25.       (or
  26.          (and
  27.             (setq en (entlast))
  28.             (while (setq e (entnext en))(setq en e))
  29.          )
  30.           (progn
  31.              (setq en (entmakex (list (cons 0 "POINT") (cons 100 "AcDbEntity") (cons 100 "AcDbPoint")(cons 10 '(0. 0. 0.)))))
  32.              (entdel en)
  33.           )
  34.       )
  35.       en
  36.    ) ; End sub-function
  37.  
  38.    ; Sub-Function "_Buildss"
  39.    ; Builds a selection set from any entities added in a drawing
  40.    ; from a marked entity.
  41.    (defun _Buildss (en / ss)
  42.       (and en
  43.          (while (setq en (entnext en))
  44.             (or ss (setq ss (ssadd)))
  45.             (if (not (wcmatch (cdr (assoc 0 (entget en))) "ATTRIB,VERTEX,SEQEND"))(ssadd en ss))
  46.          )
  47.       )
  48.       ss
  49.    ) ; End sub-function
  50.  
  51.    ; sub-function "_GetTextAlignment"
  52.    ; Converts MTEXT attachment point enum to closest TEXT alignment enum
  53.    (defun _GetTextAlignment (just / prop)
  54.         (cond
  55.                 ((= just acAttachmentPointBottomLeft)(setq prop acAlignmentLeft))
  56.                 ((= just acAttachmentPointBottomRight)(setq prop acAlignmentRight))
  57.                 ((= just acAttachmentPointBottomCenter)(setq prop acAlignmentCenter))
  58.          ((= just acAttachmentPointMiddleLeft)(setq prop acAlignmentMiddleLeft))
  59.                 ((= just acAttachmentPointMiddleRight)(setq prop acAlignmentMiddleRight))
  60.                 ((= just acAttachmentPointMiddleCenter)(setq prop acAlignmentMiddle))
  61.                 ((= just acAttachmentPointTopLeft)(setq prop acAlignmentTopLeft))
  62.                 ((= just acAttachmentPointTopCenter)(setq prop acAlignmentTopCenter))
  63.                 ((= just acAttachmentPointTopRight)(setq prop acAlignmentTopRight))
  64.         )
  65.       prop
  66.    ) ; End sub-function
  67.  
  68.    ; Set error handler
  69.    (setq err-bak *error* *error* _error)
  70.    ; Set UNDO mark.
  71.  
  72.    ; Disable command line echo
  73.    (setvar "cmdecho" 0)
  74.    (prompt "\nSelect MTEXT Object(s) to Explode: ")
  75.    ; Test to see if there are MTEXT entities selected.
  76.    (if (setq ss (ssget '((0 . "MTEXT"))))
  77.       ; If so, Start a loop reading each entity in the selection set of MTEXT objects.
  78.       (while (setq ent (ssname ss (setq cnt (if cnt (1+ cnt) 0))))
  79.          ; Get the attachment point of the MTEXT object
  80.          (setq mtap (vla-get-AttachmentPoint (setq obj (vlax-ename->vla-object ent)))
  81.                ; Convert to a TEXT alignment point.
  82.                just (_GetTextAlignment mtap)
  83.                ; Mark the last object in the drawing.
  84.                le   (_MarkLastEnt)
  85.          )
  86.          ; EXPLODE the MTEXT object.
  87.          (command "_.explode" ent)
  88.          ; Build a new selection set of the resulting TEXT entities and reset the 2nd loop counter.
  89.          (setq ss2 (_Buildss le) cnt2 nil)
  90.          ; start 2nd loop to iterate through the TEXT entities.
  91.          (while (setq ent2 (ssname ss2 (setq cnt2 (if cnt2 (1+ cnt2) 0))))
  92.             ; Get the TEXT ActiveX Object
  93.             (setq obj2  (vlax-ename->vla-object ent2)
  94.                   ; Get the Insertion Point of the TEXT
  95.                   oldip (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj2)))
  96.                   ; Get the Alignment point of the TEXT
  97.                   oldap (vlax-safearray->list (vlax-variant-value (vla-get-TextAlignmentPoint obj2)))
  98.             )
  99.             ; Change the Alignment point to the converted MTEXT value
  100.             (vla-put-Alignment obj2 just)
  101.             ; Get the new insertion point after the TEXT alignment has changed.
  102.             (setq newip (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint obj2)))
  103.                   ; Get the distance and angle from the new insertion point to the old one.
  104.                     di    (distance oldip newip)
  105.                     ag    (angle    newip oldip)
  106.                   ; Map the new alignment point location.
  107.                     newap (vlax-3d-point (polar oldap ag di))
  108.             )
  109.             ; Change the TEXT alignment point.
  110.             (vla-put-textalignmentpoint obj2 newap)
  111.          ); End loop
  112.       ); End Loop
  113.    ); End If
  114.  
  115.    ; Restore the default error handler
  116.    (if err-bak (setq *error* err-bak err-bak nil))
  117.    ; End UNDO Mark.
  118.    ; Exit quietly
  119.    (princ)
  120. ); End Command
  121.  

EDIT: Added Error Handling, removed unneeded code and added comments.
« Last Edit: September 17, 2019, 02:17:19 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #8 on: September 17, 2019, 11:12:47 AM »
PKENEWELL,

This is just what I'm looking for but there is a problem when I select more than I mtext line, it changes the first one (for example the middle center mtext) to middle text but others to bottom left justified. I really appreciate your help. If you have time and try it on my example drawing, you will see what I'm talking about. Thanks again!

David

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Exploding mtext to keep same justification for regular text
« Reply #9 on: September 17, 2019, 11:31:34 AM »
PKENEWELL,

This is just what I'm looking for but there is a problem when I select more than I mtext line, it changes the first one (for example the middle center mtext) to middle text but others to bottom left justified. I really appreciate your help. If you have time and try it on my example drawing, you will see what I'm talking about. Thanks again!

David

Oops Got it - forgot to reset a counter in the code. I have revised the code in my original post. Try it again.
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #10 on: September 17, 2019, 02:07:19 PM »
PKENEWELL,

You did it!! Thank you so much for taking time out to do this. It looks difficult as all get out! I really do appreciate and thanks again!

David

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Exploding mtext to keep same justification for regular text
« Reply #11 on: September 17, 2019, 02:14:44 PM »
PKENEWELL,

You did it!! Thank you so much for taking time out to do this. It looks difficult as all get out! I really do appreciate and thanks again!

David

No problem David. Thanks! It was actually fun and not really all that complicated. It's nice to get to code again after I haven't had time for it in a while.

NOTE: I updated the code again in my original post to include some error handling and setting undo marks, removing unnecessary code, and added comments so you can follow it. Let me know if you encounter any bugs!
« Last Edit: September 17, 2019, 02:19:36 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

notredave

  • Newt
  • Posts: 140
Re: Exploding mtext to keep same justification for regular text
« Reply #12 on: September 17, 2019, 02:25:53 PM »
Thank you very much sir

David