LISP to automatically redefine MTEXT width and Height

October 9

Hello all. I'm looking for a Lisp that enables me to just select an MTEXT -or Just apply it to the entire plan- And it automatically redefines MTEXT width and Height to be tight around the text as shown in the picture. Please let me know if you have any questions.

October 9

use this one for width of mtext

WD.VLX

October 9

Thank you! But my goal is a lisp that would automatically set up the width and height to match the text shown without any input from me.

October 9

Here is one I did a while back for the WIDTH only. (I'll see if I can add the height as well.)

NOTE: This doesn't work well with Annotative MTEXT, and it will not work if the columns are set to "dynamic"; must be set to "No Columns". (see screenshot).

(defun c:MTWID (/ _StrParse d dw obj ss tls txt wid)
   (vl-load-com)
   (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object))))

   (defun _StrParse (str del / pos)
     (if (and str del)
        (if (setq pos (vl-string-search del str))
          (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del))
          (list str)
        )
     )
   )
   
   (princ "\nSelect MTEXT Objects: ")
   (if (setq ss (ssget '((0 . "MTEXT"))))
      (repeat (setq n (sslength ss))
         (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
               txt (vla-get-textstring obj)
               dw  (vla-get-width obj)
         )
         (if (> (length (setq tls (_strparse txt "\\P"))) 1)
            (setq txt (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls)))))
         )
         ;; get the width of the longest text string
         (setq wid (apply 'max (mapcar '(lambda (x / y)(setq y (textbox (list (cons 1 x))))(- (car (cadr y)) (car (car y)))) tls)))
         (vla-put-textstring obj txt)
         (vla-put-width obj wid)
      )
   )
   (redraw)
   (vla-endundomark d)
   (princ)
)

If someone can figure our a way to scale properly with annotative text and turn off columns programmatically, then it would be good to add.

Edited October 9 by pkenewell

October 9

deleted

Edited October 13 by Nikon

October 9

1 hour ago, pkenewell said:

NOTE: This doesn't work well with Annotative MTEXT, and it will not work if the columns are set to "dynamic"; must be set to "No Columns". (see screenshot).

If someone can figure our a way to scale properly with annotative text and turn off columns programmatically, then it would be good to add.

Not quite what you want but I have this line on opening a file:

(setvar "MTEXTCOLUMN" 0)	;;Dynamic columns OFF

Just in case someone has been using columns. Just a setting, won't alter existing texts

Might be an edit - have a memory of making something up

EDIT:

Strip MText (SMT) clears columns... need to look at how

Edited October 9 by Steven P

October 9

@Someone_Pro

I found this at AutoCAD Tips: https://autocadtips1.com/2011/08/13/autolisp-text-box-width/

Command: TXTBOXWIDTH

(defun mip-mtext-wrap-BB (en / el SetHandles CheckHandles sclst)
 
   (vl-load-com)
 
;;; Argument: the ename of an mtext
;;; Shrinkwrap the bounding box of selected MText objects
 ;;; http://discussion.autodesk.com/forums/message.jspa?messageID=5734567
;;; ShrinkwrapMText v2a.lsp - Joe Burke - 10/13/2007 - Version 2a
;;;;;http://discussion.autodesk.com/forums/thread.jspa?threadID=448625
;;;; USE:
;;; (mip-mtext-wrap-BB (car(entsel)))
;;; !!!! AutoCAD 2010 2011 2012
;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/MTEXT-Column-property/m-p/2690952
;;;Need to change the column type from dynamic to not add the dxf group of 75 with 0
;;; http://www.theswamp.org/index.php?topic=28243.0
   
   (defun GetAnnoScales (e / dict lst rewind res)
   ;;; Argument: the ename of an annotative object.
   ;;; Returns the annotative scales associated with the
   ;;; ename as a list of strings.
   ;;; Example: ("1:1" "1:16" "1:20" "1:30")
   ;;; Returns nil if the ename is not annotative.
   ;;; Can be used to test whether ename is annotative or not.
   ;;; Works with annotative objects: text, mtext, leader, mleader,
   ;;; dimension, block reference, tolerance and attribute.
   ;;; Based on code by Ian Bryant.
      (if
         (and e (setq dict (cdr (assoc 360 (entget e))))
             (setq lst (dictsearch dict "AcDbContextDataManager"))
             (setq lst 
                (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
             ) ;_ end of setq
            (setq dict (cdr (assoc -1 lst))) 
         ) ;_ end of and
         (progn 
            (setq rewind t)
            (while (setq lst (dictnext dict rewind)) 
               (setq e (cdr (assoc 340 lst))
                     res (cons (cdr (assoc 300 (entget e))) res)
                     rewind nil
               ) ;_ end of setq
            ) ;_ end of while
         ) ;_ end of progn
      ) ;_ end of if 
      (reverse res)
   ) ;end
 
   (defun CheckHandles (e / dict lst rewind nlst d42 d43 n p ptlst)
   ;;; Argument: the ename of annotative mtext object.
   ;;; Returns T if the object has only one scale or
   ;;; the handles for all scales are proportionally the
   ;;; same and all scales use the same insertion point. 
      (if 
         (and e (setq dict (cdr (assoc 360 (entget e))))
            (setq lst (dictsearch dict "AcDbContextDataManager"))
            (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
            ) ;_ end of setq
            (setq dict (cdr (assoc -1 lst)))
         ) ;_ end of and
         (progn 
            (setq rewind t)
            (while (setq lst (dictnext dict rewind))
               (setq nlst (cons lst nlst)
                     rewind nil
               ) ;_ end of setq 
            ) ;_ end of while
            (cond
               ((= 1 (length nlst)))
               (t
               ;; lst is nil so reuse it.
                  (foreach x nlst
                     ;Horizontal width. Can be zero, a null text string.
                     (setq d42 (cdr (assoc 42 x))
                          ;Vertical height cannot be zero so a divide 
                          ;by zero error can't happen.
                          d43 (cdr (assoc 43 x))
                          n (/ d42 d43)
                          lst (cons n lst)
                          ;Insertion point
                          p (cdr (assoc 11 x))
                          ptlst (cons p ptlst)
                     ) ;_ end of setq
                  ) ;_ end of foreach
                  (and
                     (vl-every '(lambda (x) (equal n x 1e-4)) lst)
                     (vl-every '(lambda (x) (equal p x 1e-4)) ptlst)
                  ) ;_ end of and
               )
            ) ;_ end of cond
         ) ;_ end of progn
      ) ;_ end of if 
   ) ;end
    
   (defun SetHandles (lst / oldlst charwidth ht pat)
   ;;; ;Argument: an entget list.
   ;;; ;Code 42 is the smallest width of the handles.
   ;;; ;If 41 is larger than 42 then the handles can be shrunk
   ;;; ;horizontally given a single line mtext object.
   ;;;
   ;;; ;Code 46 is the current height of the handles in 2007/2008.
   ;;; ;Substitute the actual height from the code 43 value.
   ;;;
   ;;; ;Used to determine number of objects modified.
      (setq lst (entget (cdr(assoc -1 lst)) '("ACAD")))
      ;;; (setq oldlst lst)
      (setq charwidth (* (cdr (assoc 42 lst)) 1.05) ;_1.035
            ht (cdr (assoc 43 lst))
            lst (subst (cons 41 charwidth) (assoc 41 lst) lst)
            lst (subst (cons 46 ht) (assoc 46 lst) lst)
            lst (if (assoc 75 lst) ;;; 75 - òèï êîëîíîê
                  (subst (cons 75 0) (assoc 75 lst) lst)
                  (append lst (list(cons 75 0)))
                )
      ) ;_ end of setq
      ;;;Code 46 is the current height of the handles in 2007/2008.
      ;;;Substitute the actual height from the code 43 value.
      (if (and
            (setq pat (assoc -3 lst))
            (eq "ACAD" (caadr pat))
          ) ;_ end of and
         (progn
            (if (assoc 46 lst)
            ;;;Code 46 is the current height of the handles in 2007/2008.
            ;;; Remove extended data regarding height if found.
               (setq pat '(-3 ("ACAD")))
               (progn
                  (setq pat
                        (cons -3
                           (list (subst (cons 1040 ht)
                              (assoc 1040 (cdadr pat))
                              (cadr pat)) ;_ end of subst
                           ) ;_ end of list
                        ) ;_ end of cons
                  ) ;_ end of setq
               ) ;_ end of progn
            ) ;_ end of if
            (setq lst (subst pat (assoc -3 lst) lst))
       
         )
      ) ;_ end of if
      (setq lst (entmod lst))
   ) ;end SetHandles
 
   (if (= (cdr (assoc 0 (setq EL (entget en '("*"))))) "MTEXT")
      (progn    
         (cond    
            ((and (setq sclst (GetAnnoScales en))(CheckHandles en)) ;_ end of and
               (vl-cmdf "._chprop" en "" "_Annotative" "_No" "")
               ;(SetHandles (entget ename))
               (SetHandles el)
               (vl-cmdf "._chprop" en "" "_Annotative" "_Yes" "")
               (foreach x sclst
                  (vl-cmdf "._objectscale" en "" "_Add" x "")
               ) ;_ end of foreach
            )
            ((not (GetAnnoScales en))
               (SetHandles el)
            )
            (t nil)
         ) ;_ end of cond
      ) ;_ end of progn
   ) ;_ end of if    
) ;_ end of defun
 
(defun C:TxtBoxWidth (/ ss i)
   (and (setq ss (ssget "_:L" '((0 . "MTEXT"))))
      (repeat (setq i (sslength ss))
         (mip-mtext-wrap-BB (ssname ss (setq i (1- i))))
      )
      (setq ss nil)
   )
)

Edited October 9 by pkenewell

October 9

I think this one does dynamic columns as well:

mtxtWdtHt

(defun c:mtxtWdtHt ( / textss )
  (setq textss (ssget '((0 . "MTEXT")) ) )
  (roundtxtsizes 42 41 textss)
  (roundtxtsizes 43 46 textss)
  (princ)
)
(defun roundtxtsizes ( width1 width2 textss / ent1 acount oldwidth newwidth) ;;Rounds UP
;;Sub Functions
  (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
  (setq entlist (entget ent))


;;;  (setq textent (entget (car (entsel))))
  (if ( = (cdr (assoc 0 entlist)) "RTEXT")
    (progn
      (setq mytext (getrtext entlist))
    ) ; end progn
    (progn
      (setq enttype (cdr (assoc 0 entlist)))
      (setq acount 0)
      (while (< acount (length entlist))
        (setq acounter 0)
        (while (< acounter (length entcodes))
          (setq entcode (nth acounter entcodes))
          (if (= (car (nth acount entlist)) entcode )
            (progn
              (setq newtext (cdr (nth acount entlist)))
              (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
              (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
            );end progn
          );end if
          (setq acounter (+ acounter 1))
        );end while
        (setq acount (+ acount 1))
      );end while
;;get string from dotted pair lists
      (if (= listorstring "astring") ;convert to text
        (progn
          (if (> (length mytext) 0)
            (progn
              (setq acount 0)
              (setq temptext "")
              (while (< acount (length mytext))
                (setq temptext (cdr (nth acount mytext)) )
                (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text
                (if (= stringtext nil)
                  (setq stringtext temptext)
                  (setq stringtext (strcat stringtext temptext ))
                );end if
                (setq acount (+ acount 1))
              );end while
            );end progn
          );end if
          (if (= stringtext nil)(setq stringtext ""))
          (setq mytext stringtext)
        );end progn
      );end if
    );end progn
  ); end if
  mytext
  )

  (defun LM:roundup ( n m ) ;; Lee Mac
    ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m))
  )                             
;;End Sub functions
                             
                              
;;Set up.
  (setq acount 0)
;;update text widths
  (while (< acount (sslength textss) )
    (setq ent1 (ssname textss acount))
    (setq oldwidth (cdr (nth 0 (getfroment ent1 string (list width1))) ))
    (setq newwidth (LM:roundup (atof oldwidth) 2.5 ) )
    (entmod (subst (cons width2 newwidth)(assoc width2 (entget ent1)) (entget ent1)))
    (entupd ent1)
    (setq acount (+ acount 1))
  );end while

  (princ)
)

October 9

There is also Lee Macs Box Text function for another option...

October 10

Another... https://forums.augi.com/showthread.php?170434-MText-width-set-to-zero&s=8d83700e43971c18c05d195f56cd176a&p=1330953&viewfull=1#post1330953

Sign In

LISP to automatically redefine MTEXT width and Height

Recommended Posts

Someone_Pro

MUTHUKUMAR1983

Someone_Pro

pkenewell

Nikon

Steven P

pkenewell

Steven P

Steven P

SLW210

Join the conversation

Tutorials

Forums

Activity