(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"))
)
(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
(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
(if (= (strcase (vla-get-fontfile st))
Notice the keyword "strcase" which means you are matching the font by the case (upper case, lower case)"ARIAL UNICODE MS.tff"
This is uppercase with a lowercase extension ".ttf""ARIALUNI.TTF"
This is uppercase all the way.strcase, Returns a string where all alphabetic characters have been converted to uppercase or lowercase
Befehl: STYLE_UPDATE
; Fehler: Automatisierungsfehler Dateifehler
;; 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)
)
)
(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)
)
Befehl: (find_font "ARIALUNI.TTF")
"ARIALUNI.TTF"
(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)
)
If you select the SimSun.ttc manually, what is then the fontfile property of the text tyle?
(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 ;; 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.Try changing the FontFile property to "SimSun.ttf" programmatically. And if that works revise the 'findfile' portion of the code.