changing fonts in textstyles

Hi,

I'm trying to write a routine that runs through the textstyles in a dwg and
substitutes the font "agarde" for "century gothic"
It seems to run OK till after ENTMOD, but does not save the modification to
the style.
Anyone care to take a look?

(DEFUN c:agarde2cg ( / agarde cgothic t_style old new)
(SETQ agarde "AGARDE"
cgothic "GOTHIC.TTF"
t_style (TBLNEXT "STYLE" T)
);setq
(WHILE t_style
(IF (= agarde (STRCASE (CDR (ASSOC 3 t_style))))
(PROGN
(SETQ old (ASSOC 3 t_style)
new (CONS 3 cgothic)
t_style (SUBST new old t_style)
);setq
(ENTMOD t_style)
);progn
);if
(SETQ t_style (TBLNEXT "STYLE"))
);while
);defun
(PRINC "\nAgarde2cg")(PRINC)

 

Entmake the style with the new font, or use activeX within visual lisp.

--

AUTODESK
Authorized Developer
http://www.Cadentity.com
MASi

 

I wrote this years ago to allow change text styles by layer -

;CHS = this program is used to change text style by layer
(defun C:CHS ()
(setq ST nil SL nil)
(setq ST (tblnext "STYLE" T))
(while ST
(setq SL (append SL (list (cdr (assoc 2 ST)))))
(setq ST (tblnext "STYLE"))
)
(princ "\nAvailable Styles ")
(foreach SS SL (princ (strcat " - " SS)))
(setq LN "")
(while (= LN "")
(setq LN (strcase (getstring "\nInput Name of Layer to Change All Text
Style ? ")))
)
(setq SS (ssget "X" (list (cons 8 LN) (cons 0 "TEXT"))))
(if SS
(progn
(setq KF 0 KK 0 KS (sslength SS))
(setq LS nil)
(princ (strcat "\nChecking Layer [" LN "] for Text Styles. Please
Wait."))
(while (< KK KS)
(grtext -2 (strcat "Text " (itoa (1+ KK)) " of " (itoa KS)))
(setq EG (entget (ssname SS KK)))
(setq TS (cdr (assoc 7 EG)))
(if (not (member TS LS))
(setq LS (append LS (list TS)))
)
(setq KK (1+ KK))
)
(if (< 1 (length LS))
(progn
(princ (strcat "\nNOTE - Multiple Text Styles on Layer [" LN "]."))
(princ (strcat "\nStyles = "))
(foreach NN LS (princ (strcat NN " ")))
(setq NS (strcase (getstring "\nInput New Text Style [ENTER]=No
Change ? ")))
(setq OS (strcase (getstring "\nInput Text Style to Change or
[ENTER]=ALL ? ")))
)
(progn
(princ (strcat "\nLayer [" LN "] Current Text Style = " (nth 0 LS)))
(setq NS (strcase (getstring "\nInput New Text Style [ENTER]=No Change
? ")))
(setq OS nil)
)
)
(if NS
(progn
(setq KK 0 KS (sslength SS))
(setq LS nil)
(princ (strcat "\nChanging Text Style on Layer [" LN "]. Please
Wait."))
(while (< KK KS)
(grtext -2 (strcat "Text " (itoa (1+ KK)) " of " (itoa KS)))
(setq EG (entget (ssname SS KK)))
(setq TS (cdr (assoc 7 EG)))
(if (or (= OS "") (= OS TS))
(progn
(command "_CHANGE" (cdr (assoc -1 EG)) "" "" "" NS "" "" "")
(setq KF (1+ KF))
)
)
(setq KK (1+ KK))
)
(princ (strcat "\n" (itoa KF) " of " (itoa KS) " Text Style Changed on
Layer " LN))
)
)
)
(progn
(princ (strcat "\nNo Text Found on Layer = " LN "."))
)
)
(princ)
)

 

Cheers - that will come in handy with files we get sent from 3rd parties