need an emergency lisp changes all text styles to one

hey guys

I need an emergency lisp that changes all font's to a one font. For example there are 10 different text styles in a dwg but I want all of them in Romans.

Thanks in advance.

Iterate through the TextStyles Collection of the Document Object and change the FontFile property for each style object.

thanks for quick reply. I found this but how can I make it to change all of them to romandtw some fontstyles stay the same I think they stay out of range.

(vl-load-com)

(defun c:updateTextstyles (/ new)
(setq new (strcat (getenv "systemroot") "[url="file://\\Fonts\\romandtw.shx"]\\Fonts\\romandtw.shx[/url]"))
(vlax-map-collection
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)))
'(lambda (x / font)
(setq font (strcase (vla-get-fontfile x)))
(if (wcmatch font "ROMANS.SHX,SIMPLEX.SHX,TXT.SHX")
(vla-put-fontfile x new)))
)
(princ)
)

My first try in changing the Font Test Styles ...

(defun c:Test nil
 (vl-load-com)
 ;; Tharwat 04. 07. 2011
 (vlax-for x (vla-get-textstyles
               (vla-get-activedocument (vlax-get-acad-object))
             )
   (if (not (eq (vla-get-fontfile x) "romans.shx"))
     (vlax-put-property x 'fontfile "romans.shx")
   )
 )
 (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
            acAllViewports
 )
 (princ)
)

Tharwat

that is just perfect can we also add a line that changes width factor to 0.7 ?

can we also add a line that changes width factor to 0.7 ?

(defun c:ChangeWidth nil
 (vl-load-com)
 ;; Tharwat 05. 07. 2011
 (vlax-for x (vla-get-textstyles
               (vla-get-activedocument (vlax-get-acad-object))
             )
   (if (not (eq (vla-get-width x) 0.7))
     (vlax-put-property x 'width 0.7)
   )
 )
 (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
            acAllViewports
 )
 (princ)
)

Enjoy it buddy.

Tharwat

thanks a lot

thanks a lot

You're welcome any time .

Tharwat

(defun c:ChangeWidth nil
(vl-load-com)
;; Tharwat 05. 07. 2011
(vlax-for x (vla-get-textstyles
(vla-get-activedocument (vlax-get-acad-object))
)
(if (not (eq (vla-get-width x) 0.7))
(vlax-put-property x 'width 0.7)
)
)
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
acAllViewports
)
(princ)
)

 

Enjoy it buddy.

 

Tharwat

Dear Sir,

one problem i want few text .7 & few text .9

(defun C:TW ()
(setq p (SSGET "X" '((0 . "TEXT")(8 . "TEXT STYLE NAME"))))  ;CHANGE "TEXT STYLE NAME" TO YOUR TEXT STYLE THAT YOU WANT AT 0.7 WIDTH
(setq nwidth 0.7)                                     ;sets widths equal to 0.7
(if (/= p nil)
(progn
(setq l 0
n (sslength p))
(while (< l n)
(setq e (entget (ssname p l)))
(entmod (setq e(subst (cons 41 nwidth) (assoc 41 e) e))
)
(setq l (1+ l))))
)

;REPEATED FROM ABOVE FOR 0.9 WIDTH
(setq p (SSGET "X" '((0 . "TEXT")(8 . "TEXT STYLE NAME"))))  ;CHANGE  "TEXT STYLE NAME" TO YOUR TEXT STYLE THAT YOU WANT AT 0.9 WIDTH
(setq nwidth 0.9)                                     ;sets widths equal to 0.9
(if (/= p nil)
(progn
(setq l 0
n (sslength p))
(while (< l n)
(setq e (entget (ssname p l)))
(entmod (setq e(subst (cons 41 nwidth) (assoc 41 e) e))
)
(setq l (1+ l))))
)
(princ)
)

fab , Welcome to the forum .

Try to get used to localize you variables to avoid any mistakes and odd reaction form the routine , And please use

the

 codes here 

to wrap codes for good reading and looking .

Tharwat

blackeagle1245 & fab30 please read THIS.

Thanks, new to posting threads

@Fab30 - I'm pretty sure that this:

...
 (setq p (SSGET "X" '((0 . "TEXT")([color=red]8[/color] . "TEXT STYLE NAME"))))
...

... Should be this:

(setq p (SSGET "X" '((0 . "TEXT")([color=red]7[/color] . "TEXT STYLE NAME"))))

DXF code 8 is the object's Layer name, whereas DXF code 7 is the Text style name.

Hi, Tharwat

Do you know why your routine does not work with true type fonts?

i am trying this

(defun c:cgts6 nil
 (vl-load-com)
 ;; Tharwat 04. 07. 2011
 (vlax-for x 
(vla-get-textstyles
               
(vla-get-activedocument 
(vlax-get-acad-object))
             
)
   (if (eq (vla-get-fontfile x) 
"simplex.shx")
     (vlax-put-property x 'fontfile 
"arialn.ttf")
   )
 )
 (vla-regen 
(vla-get-ActiveDocument 
(vlax-get-acad-object))
            
acAllViewports
 )
 (princ)
)

But it simply doesn´t recognize the arialn.ttf

My first try in changing the Font Test Styles ...

 

(defun c:Test nil
 (vl-load-com)
 ;; Tharwat 04. 07. 2011
 (vlax-for x (vla-get-textstyles
               (vla-get-activedocument (vlax-get-acad-object))
             )
   (if (not (eq (vla-get-fontfile x) "romans.shx"))
     (vlax-put-property x 'fontfile "romans.shx")
   )
 )
 (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
            acAllViewports
 )
 (princ)
)

 

Tharwat

Hi, Tharwat

Do you know why your routine does not work with true type fonts?

..
   (if (eq (vla-get-fontfile x) 
"simplex.shx")
     (vlax-put-property x 'fontfile 
"arial[color=blue][b]n[/b][/color].ttf") [color=red][b];; Should be arial.ttf[/b][/color]
   )
 )

But it simply doesn´t recognize the arialn.ttf

Your question seems you're challenging me .

At all... I didn´t mean to attack you.

it's just that I tried the arialn.ttf and you know... It's my fault... arialn.ttf is the Arial Narrow font, it's part of Arial font family, but I didn´t check that it is actually in a separated file arialn.ttf which was not included in my Fonts support folder, now I downloaded it and placed it in my support folder and your routine worked perfectly.

Now I got another problem with the same width matter, but it seems more difficult or impossible... thanks for your response.

Your question seems you're challenging me .