Topic: Getting rid of True Type Fonts

[Rob...]

Hi all,

This is my first post.

The company I work for has been very slow to upgrade it's AutoCAD software. We are still using ADT3.3. We are an engineering consulting firm designing building mechanical and electrical systems. Almost all of our projects involve using architectural drawings from outside sources. You wouldn't believe some of the drafting nightmares I've come across but that's another story for another time.

I am responsible for converting and "cleaning up" incoming AutoCAD files for use as backgrounds. A recently started job has a background that started with a drawing with at least a dozen xref's. I had no problem "cleaning up" the files. The problem arose when I xref'd the background. Drawing performance slowed down dramatically, i.e. when selecting an object there was a noticeable delay between click and grip display. Okay, I've had this happen before and eliminating all true type fonts from the xref brought things up to normal speed. This drawing was different. I had to go into hundreds of mtext objects and change the font in each one because someone had overridden the style font in the mtext editor! I expect many updates for this particular background.

Does anyone have a routine that will automate this process for me?

Rob

[T.Willey]

First off, welcome to theswamp.  I'm sure you will find many helpful people here, and you will enjoy your stay.

Now for your question.  Here is one I wrote that will strip the formatting from mtext, and the fromatting is color, font, width and height.  After you call the command, you can just type 'all' at the command line and it will select all the mtext objects in the draiwng.  Have fun with it.

Code: [Select]

(defun c:StpMtext (/ ss ent1 ent2 tstr1 tstr2)
; Strips Mtext of certain formating

(command "_.undo" "_end")
(command "_.undo" "_group")
(if (setq ss (ssget '((0 . "MTEXT"))))
 (while (/= (sslength ss) 0)
  (setq ent1 (ssname ss 0))
  (setq ent2 (vlax-ename->vla-object ent1))
  (setq tstr1 (vlax-get ent2 'TextString))
  (setq tstr2 (StripString tstr1))
  (vlax-put ent2 'TextString tstr2)
  (ssdel ent1 ss)
 ); while
); if
(command "_.undo" "_end")
(princ)
)

;-------------------------------------

(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

(setq cnt1 1)
(while (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
 (if (= cstr1 "\\")
  (progn
   (setq cstr2 (substr String 2 1))
   (if (member (strcase cstr2) '("C" "F" "H" "W"))
    (progn
     (while (/= (substr String cnt1 1) ";")
      (setq cnt1 (1+ cnt1))
     ); while
     (setq String (substr String (1+ cnt1) (strlen String)))
     (setq cnt1 1)
    ); progn
    (progn
     (if nString
      (setq nString (strcat nString (substr String 1 1)))
      (setq nString (substr String 1 1))
     ); if
     (setq String (substr String 2 (strlen String)))
    ); progn
   ); if
  ); progn
  (progn
   (if nString
    (setq nString (strcat nString (substr String 1 1)))
    (setq nString (substr String 1 1))
   ); if
   (setq String (substr String 2 (strlen String)))
  ); progn
 ); if
); while
(setq tstr1 (vl-string->list nString))
(if (and (not (member 92 tstr1)) (member 123 tstr1))
 (setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
); if
(vl-list->string tstr1)
)


[ronjonp]

This is the routine I use to strip mtext formatting.

http://www.users.qwest.net/~sdoman/

[CAB]

And my Stripper. 
http://www.theswamp.org/index.php?topic=7272.0

[Rob...]

Hi again and thanks for the quick responces. I tried T.Willey's and it worked. if I have time I will try the others later. I'm glad that I'm not the only one with problems with this. Thanks again.

[T.Willey]

I tried T.Willey's and it worked.

I win!!! 

Glad it worked for you Rob.

[Birdy]

...and welcome to the Swamp

[Maverick®]

...and welcome to the Swamp

What Birdy said.  And great Avatar BTW. 

[Rob...]

Thank you. Thank you.

[CAB]

There may be cases where there are over rides that you don't want to strip.
Like height over rides, but you still want to change the font.
This routine will replace the target font with one of you choosing.
Note that the intent is to replace a TrueType font with an ACAD font.
You should not use this routine to put a TrueType font in the mtext as there
may not be enough information for the TT font to work properly.

Code: [Select]

;;  replaces font override in mtext in entire drawing

(defun c:ReplaceFont (/ *doc FLAG LST NEWFONT OBJ OLDFONT POS POS2 SS TXT)
  (vl-load-com)
  (setq *doc  (vla-get-activedocument (vlax-get-acad-object)))
  ;;  font to replace & new font to use
  (setq OldFont "Romantic") ; <- Must match case
  (setq NewFont "romans.shx"); must be a ACAD font

  (vla-endundomark *doc)
  (vla-startundomark *doc)

  (setq ss (ssget "X" '((0 . "mtext"))))
  (setq lst (mapcar 'cadr (ssnamex ss)))
  (setq OldFont (strcat "\\f" OldFont))
  (setq NewFont (strcat "\\f" NewFont))
  (foreach itm lst
    (setq obj  (vlax-ename->vla-object itm)
          txt  (vla-get-textstring obj)
          flag nil
    )
    (while (setq pos (vl-string-search OldFont txt))
      (setq pos2 (vl-string-search ";" txt pos))
      (setq
        txt (vl-string-subst NewFont (substr txt (1+ pos) (- pos2 pos)) txt)
      )
      (setq flag t)
    )
    (if flag
      (vla-put-textstring obj txt)
    )
  )
  (vla-regen *doc acAllViewports)
  (vla-endundomark *doc)

  (princ)
)

[Atook]

I just used Tim's solution. Saved me a bunch of time.

I just love this place, thanks Tim!