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

[eldanimal]

OK, so i think that my problem is the font i am trying to use, SimSun, is peculiar, it is a ttc rather than a ttf or shx.  I added to CAB's code with a different "put wrap" (i am making up terminology because I know very little) from Fixo on a similar problem, and I changed the input font to simplex_.ttf to test.  I also tried to use simsun.ttc, and it did replace the font in the styles, but it did not recognize the "SimSun" font I would be able to manually select if I went through all my different styles in all our different template drawings.  Instead it gave me the attached jpg.

Here is the code I am currently working with:

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)) "SIMSUNB.TTF")
      (vl-catch-all-apply
      '(lambda ()
(progn
   (setq fontfile (findfile (strcat (getenv "WINDIR") "\\fonts\\Simplex_.ttf")))
   (vla-put-fontfile st fontfile)
   )
)
    )
  )
  )
  (princ)
)


I guess I am actually looking for a way to access the ttf's in simsun.ttc, but like I said, I really don't know very much.

Thank you all, again,
Dan

[roy_043]

If you select the SimSun.ttc manually, what is then the fontfile property of the text tyle?

[eldanimal]

If you select the SimSun.ttc manually, what is then the fontfile property of the text tyle?

If I manually change the font in the text style to SimSun and then run this

Code: [Select]

(vl-load-com)
(defun c:cf()
    ;; This example returns the current setting of
    ;; the FontFile property. It then changes the value, and
    ;; finally resets the value back to the original setting.
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq textStyle1 (vla-get-ActiveTextStyle doc))
   
    ;; Retrieve the current FontFile value
    (setq currFontFile (vla-get-FontFile textStyle1))
    (alert (strcat "The current value for FontFile is " currFontFile))
)....I get the first screen capture, but then when i run 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)
  )
)....I get the second capture.

[roy_043]

Try changing the FontFile property to "SimSun.ttf" programmatically. And if that works revise the 'findfile' portion of the code.

[eldanimal]

Try changing the FontFile property to "SimSun.ttf" programmatically. And if that works revise the 'findfile' portion of the code.

It does not work. I think I am stuck hoping there is a VLISP process for unpacking a .ttc that I just can't find.

Thank you for the responses, Roy. I think I have a clearer target now.

[eldanimal]

I did manage to break through on this....unfortunately, I was not very methodical, and I'm uncertain of exactly how I pulled it off, but I think that it could be worthwhile for someone down the road to know what I did to accomplish what I wanted, so here goes....

First, I tried to download a copy of the SimSun.ttf package w/out the *.ttc package.  Windows seemed to reject the installation of that file, because it knew it was already there.

Next, I searched for other programs that handle ttc's and found that the filetype uses an index for each of the ttf components of the ttc....so i started to mess w/ the code I was using to try to call the simsun.ttf. i.e.,
(setq fontfile (findfile (strcat (getenv "WINDIR") "\\fonts\\SimSun.ttf, 0")))
(setq fontfile (findfile (strcat (getenv "WINDIR") "\\fonts\\SimSun.ttf; 0")))
(setq fontfile (findfile (strcat (getenv "WINDIR") "\\fonts\\SimSun.ttf[0]")))

And then I threw a random Hail Mary:  (setq fontfile (findfile (strcat (getenv "WINDIR") "\\fonts\\SimSun.ttf")))...and the code worked.

I went back and checked the fonts, and I now had NSimSun.ttc that included a NSimSun.ttf and a SimSun.ttf and a SimSun_0.ttf.   I was unsure why the above code worked considering, but it did.

Now after 20 restarts or so, I have NSimSun.ttc and SimSun.ttc in my fonts, both contain the NSimSun.ttf and the SimSun.ttf with no independent SimSun_0.ttf to be found.

[ronjonp]

Also check the registry to make sure the font is using the correct ttf file. Those numbered ttf files come from installing a font multiple times and if you install a wonky one, then you're hosed.
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

If you're using Windows 10 and want to see the font files individually, you can paste this into Windows Explorer to do so:
\\%computername%\c$\Windows\Fonts

[eldanimal]

Thank you for the heads up, Ron.....I do have the SimSun_0.ttf file in there.  I don't think I am in trouble, because I ran the code on a shared file that another user was able to open, use and plot w/out any trouble or font installations.  Is that a file I can simply delete for the future? 

I'm thinking that I was actually ready to roll when I tried to install the plain SimSun.ttf despite Windows' complaint, and my fancy index calls just kept me occupied for a few hours.....