TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: JGA on June 22, 2011, 05:46:47 AM

Title: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: JGA on June 22, 2011, 05:46:47 AM
Hi, I was wondering if anyone has developed or knows of a tool that can help me.
I've inherited a project where the original drafter was inexperienced in AutoCAD.
One of the problems is that the width of mtext boxes have not been compacted down to the width of the text.

It would be impractical for me to open each mtext entry & double click on the ruler end, so I wondered if there is a routine that can do this with a selection of text in a drawing.

My own LISP experience is limited to creating shortcuts for regular commands (ZE-Zoom Extents etc.), so this is beyond my current limits.
Thanks in advance for anyone who can help, or point me in the right direction.

PS - One great tool I found was StripMtext from Steve Doman and Joe Burke at http://cadabyss.wordpress.com/. It removes additional formatting from Mtext. It is superb!
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Kerry on June 22, 2011, 06:18:45 AM
http://www.theswamp.org/index.php?topic=4592.msg55517#msg55517

Welcome to TheSwamp ;)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: jonesy on June 22, 2011, 06:29:23 AM
Without wanting to cause problems/stir the waters etc...

Can someone explain the advantages of having a text box compacted to fit the width of a text?

Thanks
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 06:36:38 AM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Krushert on June 22, 2011, 07:28:43 AM
Without wanting to cause problems/stir the waters etc...

Can someone explain the advantages of having a text box compacted to fit the width of a text?

Thanks

The user then has to grip edit the each and every piece of text to change the width to get the text to fit into the detail box or viewport.  It is just a big PITA.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Matt__W on June 22, 2011, 08:25:39 AM
You could use QSELECT to select all MTEXT entities then change their properties all at once.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Nibster on June 22, 2011, 08:43:41 AM
You could use QSELECT to select all MTEXT entities then change their properties all at once.
that could mess up the formatting if some text was wider than the new width value.  sounds like autowrap wasn't used if the box is wider than the contents.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 09:19:39 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Krushert on June 22, 2011, 09:22:11 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 09:29:59 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Ouch. I just don't see the benefit of an MText width. Then again, most of my non c3d labels are single lines of MText - only using MText over DText because I can use a background mask when needed. Nothing irritates me more than turning on a background mask for a piece of text (especially a road name) and suddenly half my drawing is blacked out because some retard decided to create the MText with a gigantic width.

Here's what I use for dealing with widths:

Change width of selected text:
Code: [Select]
(defun c:WD (/ ss wd)
  ;; Change width of selected MText and MultiLeader objects
  ;; Alan J. Thompson, 11.05.09
  (if (and (setq ss (ssget "_:L" '((0 . "MTEXT,MULTILEADER"))))
           (setq wd (initget 4)
                 wd (cond ((getdist "\nWidth <0.0>: "))
                          (0.)
                    )
           )
      )
    (progn
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (vl-catch-all-apply
          (function vlax-put-property)
          (list x
                (cond ((eq (vla-get-objectname x) "AcDbMText") 'Width)
                      ((eq (vla-get-objectname x) "AcDbMLeader") 'TextWidth)
                )
                wd
          )
        )
      )
      (vla-delete ss)
    )
  )
  (princ)
)

My zero width by default MText macro (I can right-click on the first pick and it will resume normal MText behavior for when I'm typing notes in paperspace and want the use of wordwrap.
Code: [Select]
; mtext with 0 width
(defun c:T (/ pt)
  (initdia)
  (command "_.mtext")
  (if (setq pt (getpoint "\nSpecify insertion point <First corner>: "))
    (command "_non" pt "_W" 0.)
  )
  (princ)
)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: ronjonp on June 22, 2011, 10:01:05 AM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 10:10:53 AM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?
Works in 11 for the width, but not the height.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Krushert on June 22, 2011, 10:13:39 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Ouch. I just don't see the benefit of an MText width. Then again, most of my non c3d labels are single lines of MText - only using MText over DText because I can use a background mask when needed. Nothing irritates me more than turning on a background mask for a piece of text (especially a road name) and suddenly half my drawing is blacked out because some retard decided to create the MText with a gigantic width.
that user had other issues more serious than cad standards.  But not following cad standards was one of the items on the list.  Your example is good one why we can and need to be different in our cad standards.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 10:19:57 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Ouch. I just don't see the benefit of an MText width. Then again, most of my non c3d labels are single lines of MText - only using MText over DText because I can use a background mask when needed. Nothing irritates me more than turning on a background mask for a piece of text (especially a road name) and suddenly half my drawing is blacked out because some retard decided to create the MText with a gigantic width.
that user had other issues more serious than cad standards.  But not following cad standards was one of the items on the list.  Your example is good one why we can and need to be different in our cad standards.
That's a different situation. If I was told I had to have a width because of standards, I might argue the 'point', but in the end I'd obviously comply...unless you saw things my way. Mostly it just irritates the hell out of me when people use the width and are incredibly sloppy about it.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: ronjonp on June 22, 2011, 10:22:00 AM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?
Works in 11 for the width, but not the height.

This works for me (height and width)

Code: [Select]
(defun c:test (/ ss i e)
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (setq e (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e)))
      (entmod (subst (cons 46 (cdr (assoc 43 e))) (assoc 46 e) e))
    )
  )
  (princ)
)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Keith™ on June 22, 2011, 10:54:43 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Ouch. I just don't see the benefit of an MText width. Then again, most of my non c3d labels are single lines of MText - only using MText over DText because I can use a background mask when needed. Nothing irritates me more than turning on a background mask for a piece of text (especially a road name) and suddenly half my drawing is blacked out because some retard decided to create the MText with a gigantic width.
that user had other issues more serious than cad standards.  But not following cad standards was one of the items on the list.  Your example is good one why we can and need to be different in our cad standards.
That's a different situation. If I was told I had to have a width because of standards, I might argue the 'point', but in the end I'd obviously comply...unless you saw things my way. Mostly it just irritates the hell out of me when people use the width and are incredibly sloppy about it.

I have always utilized a width factor and find it quite irritating that many drawings I receive have no mtext width. The issue is that when creating presentation drawings, the text must be formatted in such a way that allows for width adjustments when there are multiple lines of text. Sometimes a hard carriage return is desired and we have used that.

Ask yourself why every good text editor uses line wrapping, then ask yourself why wouldn't you utilize that in a drawing too.

Incidently, one of the major items I would love to have in mtext formatting would be fit justification for a paragraph.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 10:57:26 AM
If you use carriage returns instead of the autowrapper (based on MText width), you could just set the width to zero.
And that my friend would get you a lotto of grief in my office.  That was one reason a user was fired for that.

But hey that is just how we roll with out limited, word of mouth, subject to change with the wind, cad standards.  :roll:
Ouch. I just don't see the benefit of an MText width. Then again, most of my non c3d labels are single lines of MText - only using MText over DText because I can use a background mask when needed. Nothing irritates me more than turning on a background mask for a piece of text (especially a road name) and suddenly half my drawing is blacked out because some retard decided to create the MText with a gigantic width.
that user had other issues more serious than cad standards.  But not following cad standards was one of the items on the list.  Your example is good one why we can and need to be different in our cad standards.
That's a different situation. If I was told I had to have a width because of standards, I might argue the 'point', but in the end I'd obviously comply...unless you saw things my way. Mostly it just irritates the hell out of me when people use the width and are incredibly sloppy about it.

I have always utilized a width factor and find it quite irritating that many drawings I receive have no mtext width. The issue is that when creating presentation drawings, the text must be formatted in such a way that allows for width adjustments when there are multiple lines of text. Sometimes a hard carriage return is desired and we have used that.

Ask yourself why every good text editor uses line wrapping, then ask yourself why wouldn't you utilize that in a drawing too.

Incidently, one of the major items I would love to have in mtext formatting would be fit justification for a paragraph.
In most situations, I'm not labeling with a long not, it's a couple/one short line of text that I want broken up with carriage returns. Hence the reason I use a zero width to solve any text width issues. Sure, if I'm typing some note, you can guarantee I'll use a wordwrap. I guess I didn't make myself clear enough; sorry about that.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 02:28:16 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.

Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 02:30:01 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 02:38:01 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.

No, not annotative.  :|
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 02:45:17 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.

No, not annotative.  :|
Odd. You code worked for me with annotative text in 2011, but only on the width, not the height and ron's code didn't do anything.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 02:49:44 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.

No, not annotative.  :|
Odd. You code worked for me with annotative text in 2011, but only on the width, not the height and ron's code didn't do anything.

Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 02:51:37 PM
Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
WTF, that's really odd. Out of curiosity, does the width program I posted earlier work for you?
Title: Re: Is there a tool to compact Mtext boxes?
Post by: ronjonp on June 22, 2011, 02:59:57 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.

No, not annotative.  :|
Odd. You code worked for me with annotative text in 2011, but only on the width, not the height and ron's code didn't do anything.

This didn't work for you Alan? Try it again ... I reposted because I forgot to set the elist to "e" in the first entmod.

http://www.theswamp.org/index.php?topic=38691.msg437960#msg437960
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 03:02:44 PM
I thought something like this, but upon testing, I can't seem to get it to work  :-(

Code: [Select]
(defun c:test ( / ss i e )
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (entget (ssname ss (setq i (1- i)))))
      (entmod (subst (cons 41 (cdr (assoc 42 e))) (assoc 41 e) e))
    )
  )
  (princ)
)

Works here Lee  :?

Just tried again and still can't get it working (ACAD2010 Student) - attached is a quick screen grab.


Is the text annotative? Not that it would/could change things, but you never know.

No, not annotative.  :|
Odd. You code worked for me with annotative text in 2011, but only on the width, not the height and ron's code didn't do anything.

This didn't work for you Alan? Try it again ... I reposted because I forgot to set the elist to "e" in the first entmod.

http://www.theswamp.org/index.php?topic=38691.msg437960#msg437960
Cool, that worked. I doubt I'll ever use it, but It's going in the toolbox. :)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 03:04:51 PM
Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
WTF, that's really odd. Out of curiosity, does the width program I posted earlier work for you?

Nope. I added a vl-catch-all-error-p/message to check it if the vl-catch-all-apply threw an error, but no error, it just doesn't do anything.

Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 03:08:27 PM
Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
WTF, that's really odd. Out of curiosity, does the width program I posted earlier work for you?

Nope. I added a vl-catch-all-error-p/message to check it if the vl-catch-all-apply threw an error, but no error, it just doesn't do anything.


How odd. We jumped from 9 to 11, so I can't even venture an opinion about 2010 issues. Speaking of, since you don't have to pay for it, why not upgrade, or do they allow for that? Work allows for me to have a full-blown copy at home, so I haven't experimented.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: Lee Mac on June 22, 2011, 03:14:42 PM
Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
WTF, that's really odd. Out of curiosity, does the width program I posted earlier work for you?

Nope. I added a vl-catch-all-error-p/message to check it if the vl-catch-all-apply threw an error, but no error, it just doesn't do anything.

How odd. We jumped from 9 to 11, so I can't even venture an opinion about 2010 issues. Speaking of, since you don't have to pay for it, why not upgrade, or do they allow for that? Work allows for me to have a full-blown copy at home, so I haven't experimented.

They do offer a student upgrade to '11 but I was happy with 2010 so never chose/couldn't be bothered to upgrade  :-)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: alanjt on June 22, 2011, 03:22:51 PM
Yeah, I've only set it to update the Width at this point (stopped when I couldn't even get that working...). (vla-put-width <MText>) doesn't work either for me. Also, the 'Defined Width' property in the Properties Panel for the object is greyed out (uneditable) - is this normal?
WTF, that's really odd. Out of curiosity, does the width program I posted earlier work for you?

Nope. I added a vl-catch-all-error-p/message to check it if the vl-catch-all-apply threw an error, but no error, it just doesn't do anything.

How odd. We jumped from 9 to 11, so I can't even venture an opinion about 2010 issues. Speaking of, since you don't have to pay for it, why not upgrade, or do they allow for that? Work allows for me to have a full-blown copy at home, so I haven't experimented.

They do offer a student upgrade to '11 but I was happy with 2010 so never chose/couldn't be bothered to upgrade  :-)
Right on. Just curious.
Title: Re: Is there a tool to compact Mtext boxes?
Post by: VVA on June 22, 2011, 03:23:33 PM
My wariant
Code: [Select]
(defun mip-mtext-wrap-BB (en / el SetHandles CheckHandles sclst)
;;; 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 C:TEST ()
  (and
    (setq mtext (car(entsel "\nSelect Mtext to change columns type: ")))
    (setq lst (entget mtext))
    (= (cdr(assoc 0 lst)) "MTEXT")
    (setq lst (if (assoc 75 lst)                        
     (subst (cons 75 0) (assoc 75 0) lst)
     (append lst (list(cons 75 0)))
     )
 )
    (entmod lst)
    )
  (princ)
  )
|;
  

  (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 0) 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
Use
Code: [Select]
(defun C:TEST (/ 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)
  )
)
Title: Re: Is there a tool to compact Mtext boxes?
Post by: JGA on June 27, 2011, 11:00:08 AM
My apologies for not monitoring this thread more closely.
Thanks to all who showed interest & those who provided a response & tools to help.
In the end I didn't get any of the tools to work as intended, other than those which reduced the mtext width to "0". This may be because I'm currently on ACA 2011 (in vanilla AutoCAD mode), or the drawing, which has given me a few problems already.

Anyway - I'm pleased to report that the routine FX.lsp from http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/MText-Set-Limits-Box-to-minimum/m-p/1527939/highlight/false works fine without a problem for both ANNOTATIVE & normal text.
It will change the width to the longest line of text in the mtext box. Now I just need it to change the height... :wink:

Thanks again.

Regards,
JGA
Title: Re: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: Joe Burke on June 30, 2011, 08:31:58 AM
Search for the routine which I think I posted here somewhere named ShinkwrapMText v2a.lsp.

It should do what you want, if I understand the question correctly.
Title: Re: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: JGA on June 30, 2011, 08:48:16 AM
Joe,
Thanks for your comment. I had a search in the site & using Google without success, but the fx.lsp does the job for me.
Title: Re: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: 3dwannab on April 07, 2018, 01:06:53 PM
I know I'm late but here's the link for ShrinkwrapMText v2a.lsp.

https://autocadtips1.com/2011/08/13/autolisp-text-box-width/
Title: Re: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: ScottMC on April 07, 2018, 11:30:53 PM
Using my A2K got MATCHPROP to do exactly what's wanted and wondering why this wasn't posted..
Title: Re: Is there a tool to compact Mtext boxes? - SOLVED!
Post by: JGA on April 09, 2018, 04:26:00 AM
3dwannab, better late than never! Thanks.

ScottMC - A2K?