Topic: changing font of text style at startup

[rkitek]

Our office recently decided to change our 'standard' font from a TTF to a SHX. Rather than tediously going drawing by drawing to changing the font definition w/ 'style', I thought it would be nice if I could make the font change upon opening the dwg. I'm having a little trouble getting it to work, so any help would be much appreciated...

Basically, I'm trying to get all styles w/ font 'cgor45x.ttf' be replaced w/ 'cgor45x.shx'. The ttf font actually is listed in the flyout as "CG Omega"

Here's what I've got now:

Code: [Select]

(VL-LOAD-COM)
   (SETQ *DOC*
      (VLA-GET-ACTIVEDOCUMENT
      (VLAX-GET-ACAD-OBJECT)
      )
   )
   (SETQ STYLES
      (VLA-GET-TEXTSTYLES *DOC*)
   )
   (VLAX-FOR STYLE STYLES
      (IF (= (VLA-GET-FONTFILE STYLE) "CG Omega") ;;;I also tried "cgor45xf.ttf"
      (VLA-PUT-FONTFILE STYLE "cgor45xf.shx"))
   )

Am I way off here? Thanks in advance.

[Sdoman]

Try setting the textstyle you want to modify active, then run the following code:

(vlax-dump-object  (vla-get-activetextstyle *doc*) t)

The report generated should show what the font file name is.  Also, beware of string case when comparing strings.

(IF (= (strcase (VLA-GET-FONTFILE STYLE)) "YOURFONT.TTF")...

[CAB]

Yep, that should do it...
Here is another way to wrap it.

Code: [Select]

(defun c:style_Update (/ st)

  (vl-load-com)

  (vlax-for st
               (vla-get-textstyles
                 (vla-get-activedocument (vlax-get-acad-object))
               )
    ;;  Old font file in CAPS
    (if (= (strcase (vla-get-fontfile st)) "CGOR45XF.TTF")
      (vla-put-fontfile st "cgor45xf.shx") ; New font file name
    )
  )
  (princ)
)

(c:style_Update) ; run it

[rkitek]

Thanks for your help, works perfectly now!

[Kerry]

Heh, CAB,

Just a comment to acknowledge how much your code has changed in the last couple of years.

I know you may come over all blushy and blame some of the guys here, but I see it primarily as a result of the effort you put in.

great stuff !!

Regards
Kerry

[CAB]

Thank you sir.

If you hang around here & AUGI long enough you gota learn somethin.
As you said I do practice a lot. Although posting a lot of code shows your
progress you risk a failure now & then. But I think it's worth the risk.

Now if I could only learn to spel.

[Hugo]

For me this does not work, the style is not changed.
Please help

Bei mir funktioniert das nicht der Stil wird nicht geändert.
Bitte um Hilfe

Code: [Select]

(defun c:style_Update (/ st)

  (vl-load-com)

  (vlax-for st
               (vla-get-textstyles
                 (vla-get-activedocument (vlax-get-acad-object))
               )
    ;;  Old font file in CAPS
    (if (= (strcase (vla-get-fontfile st)) "ARIAL UNICODE MS.tff")  ;;"ARIALUNI.TTF")
      (vla-put-fontfile st "ARIAL.ttf") ; New font file name
    )
  )
  (princ)
)

(c:style_Update) ; run it
Because the font is much too large
Denn die Schrift ist viel zu gross

Why is the font does not replace what is wrong
Thank you

Warum wird die Schrift nicht ersetzt wo liegt der Fehler
Danke

[Hangman]

Hello Hugo,

Just a guess here as I'm not quite proficient with vlisp yet but you have the code

Code: [Select]

(if (= (strcase (vla-get-fontfile st))Notice the keyword "strcase" which means you are matching the font by the case (upper case, lower case)
So the question here then 'is your fonts lower case or upper case?'

Code: [Select]

"ARIAL UNICODE MS.tff"  This is uppercase with a lowercase extension ".ttf"

Code: [Select]

"ARIALUNI.TTF"  This is uppercase all the way.

Perhaps I am misleading here, but according to the 'help' files,

strcase, Returns a string where all alphabetic characters have been converted to uppercase or lowercase

[Hugo]

Hallo Hangman

That's also not get the following error

Befehl: STYLE_UPDATE
; Fehler: Automatisierungsfehler Dateifehler

Das ist es auch nicht bekomme folgende Fehlermeldung

[CAB]

Try this:

Code: [Select]

;;  returns nil if not found, else font name if found
;;  TTF file names should have the extension already added
;;  "romant.ttf"
(defun find_font (fname / path font$)
  (setq path (getenv "windir"))
  (if (vl-position (substr path (strlen path)) '("/" "\\"))
    (setq path (strcat path "FONTS\\"))
    (setq path (strcat path "\\FONTS\\"))
  )
  (setq font$ (if (wcmatch fname "*\\*,*`.*")
                fname
                (strcat fname ".shx")
              )
  )

  (cond
    ((findfile font$) font$)
    ((and path (findfile (strcat path font$))) font$)
    (t nil)
  )
)
(find_font "ARIALUNI.TTF")

[CAB]

As Hangman suggested:

Code: [Select]

(defun c:style_update (/ st)
  (vl-load-com)
  (vlax-for st (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
    ;;  Old font file in CAPS
    (if (= (strcase (vla-get-fontfile st)) "ARIAL UNICODE MS.TTF")
      ;;"ARIALUNI.TTF")
      (vla-put-fontfile st "ARIAL.ttf") ; New font file name
    )
  )
  (princ)
)

[Lee Mac]

@CAB,
Here is an alternative method to retrieve the Fonts path:

Code - Auto/Visual Lisp: [Select]

1. ;; Special Folder  -  Lee Mac
2. ;; Queries the WshSpecialFolders collection for the specified folder
3. ;; Ref: http://msdn.microsoft.com/en-us/library/9x9e7edx%28v=vs.85%29.aspx
4.  
5. (defun LM:SpecialFolder ( folder / res spf wsh )
6.     (setq res
7.         (vl-catch-all-apply
8.             (function
9.                 (lambda ( )
10.                     (setq wsh (vlax-get-or-create-object "wscript.shell")
11.                           spf (vlax-get-property wsh 'specialfolders)
12.                     )
13.                     (vlax-invoke-method spf 'item folder)
14.                 )
15.             )
16.         )
17.     )
18.     (if spf  (vlax-release-object  spf))
19.     (if wsh  (vlax-release-object  wsh))
20.     (if (not (vl-catch-all-error-p res))
21.         res
22.     )
23. )

Code - Auto/Visual Lisp: [Select]

1. _$ (LM:SpecialFolder "Fonts")
2. "C:\\Windows\\Fonts"

[CAB]

Thanks Lee 

[Hugo]

Hallo CAB

Scripture is found.

Befehl: (find_font "ARIALUNI.TTF")
"ARIALUNI.TTF"

Schrift wird gefunden.

[eldanimal]

I think I am having problems similar to Hugo, and mein Deutsch ist nicht so gut, but I'm not sure this thread fixed his problem.

I am using the following w/ just modified fonts from CAB's original code w/out success:

(defun c:style_Update (/ st)

  (vl-load-com)

  (vlax-for st
               (vla-get-textstyles
                 (vla-get-activedocument (vlax-get-acad-object))
               )
    ;;  Old font file in CAPS
    (if (= (strcase (vla-get-fontfile st)) "SIMSUNB.TTF")
      (vla-put-fontfile st "SIMSUN.TTC") ; New font file name
    )
  )
  (princ)
)

(c:style_Update) ; run it

On load I get the following: ; error: Automation Error. Filer error
This is the same as: ; Fehler: Automatisierungsfehler Dateifehler

Also, Hugo's translator read that "Scripture is found", and that sure sounds like a resolution....Amen, Amen, but I think he really meant that the find_font script is just finding the Font.

I have also run the find_font script on both of the attached, neither finds "SIMSUN" and both find "SIMSUN.TTC", but the style_update script is not working on either.

I also tried removing strcase from the style_update script, and the filer error disappeared, but the results did not change.

Thank you all for any help,
Dan