Font availability check

[cadconcepts]

Hi Everyone-

I am looking for help with a routine that will check to see if a font in either .shx or .ttf is available on your system. I have a routine that creates numerous default text styles but it bombs out when it cannot find a specified font. Thanks in advance.

Manuel A. Ayala

[kennet.sjoberg]

Hi Manuel, I do not use .ttf my self but maybe You can find help with this code


(defun c:ChkFontStyles ( / FontList )
(setq FontList (list (cdr (assoc 2 (tblnext "STYLE" T )))) )
(while (car (reverse FontList ))
(setq FontList (append FontList (list (cdr (assoc 2 (tblnext "STYLE" nil ))))) )
)
(setq FontList (vl-remove nil FontList ) )
(foreach FontStyle FontList
(princ
(strcat
"\n\nStyle " FontStyle " belong to fontfile " (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))
"\nin Fontfile "
(if (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))
(findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))
"that is not in the searchpath, or missing the file extension."
)
)
)
)
(textscr)
(princ "\n\nHappy Computing !\n\nkennet" )
(princ)
)

: ) Happy Computing !

kennet

[CADmium]

Try this:


(defun DT:FONT_EXIST (FONTFILE / )
(if (=(type FONTFILE) 'STR)
(progn
(setq FONTFILE (strcase FONTFILE 'T))
(if (not(vl-string-search "." FONTFILE)) (setq FONTFILE (strcat FONTFILE ".shx")))
(cond
((=(vl-filename-extension FONTFILE)".SHX")
(if (findfile FONTFILE) FONTFILE)
)
((and(=(vl-filename-extension FONTFILE)".TTF")
(vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
"SystemRoot"
)
(findfile(strcat
(vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
"SystemRoot"
)
"\\FONTS\\"
FONTFILE
)
)
)
FONTFILE
)
)
)
)
)

[kennet.sjoberg]

Hi Manuel, updated for Windows *.ttf searchpath


(defun c:ChkFontStyles ( / FontList WinPath )
(setq FontList (list (cdr (assoc 2 (tblnext "STYLE" T )))) )
(while (car (reverse FontList ))
(setq FontList (append FontList (list (cdr (assoc 2 (tblnext "STYLE" nil ))))) )
)
(setq FontList (vl-remove nil FontList ) )
(setq WinPath (strcat (getenv "windir" ) "\\fonts\\" ) )
(foreach FontStyle FontList
(princ
(strcat
"\n\nStyle " FontStyle " belong to fontfile " (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))
"\nlocated in "
(cond
((= (wcmatch (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) "*.*" ) nil )
(findfile (strcat (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) ".shx" )) )
((= (type (findfile (strcat WinPath (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) ))) 'STR )
(findfile (strcat WinPath (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) )) )
((= (type (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))) 'STR )
(findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))) )
(t "missplaced AutoCADs or missplaced Windows font searchpath,\nfile not found." )
)
)
)
)
(textscr)
(princ "\n\nHappy Computing !\n\nkennet" )
(princ)
)

: ) Happy Computing !

kennet

[cadconcepts]

Hi Everyone-

Thanks for the replies. I think both of these routines will do the job. Many many thanks.

Manuel