how to display all available fonts ?

hi,

how to display all available fonts ?
It's ok for TTF, but how to do that for SHX without :

(setq path_autocad (vla-get-Path (vlax-get-acad-object)))
(setq path_autocad_font (strcat path_autocad "\\Fonts\\"))
(vl-directory-files path_autocad_font "*.shx" 1)

note : this is not correct if \\Fonts\\ is not fonts folder.

I want to display all available fonts like command : STYLE

in all examples, font's path and font's name are hardcoded.

thx
Bruno Toniutti
(sorry for my english level but i will understand you)

 

;;List fonts (*.shx)
(defun strParse (Str Delimiter / SearchStr StringLen return n char)
(setq SearchStr Str)
(setq StringLen (strlen SearchStr))
(setq return '())
(while (> StringLen 0)
(setq n 1)
(setq char (substr SearchStr 1 1))
(while (and (/= char Delimiter) (/= char ""))
(setq n (1+ n))
(setq char (substr SearchStr n 1))
); end while
(setq return (cons (substr SearchStr 1 (1- n)) return))
(setq SearchStr (substr SearchStr (1+ n) StringLen))
(setq StringLen (strlen SearchStr))
); end while
(reverse return)
); end defun

;; get acad env - support files list
(setq flist (list))
(setq lst (mapcar 'strcase (strParse (getenv "ACAD") ";")))
(foreach path lst
(setq fonts nil)
(setq fonts (list (vl-directory-files path "*.shx" 1)))
(if fonts
(progn
(foreach font fonts
(if font
(progn
(if (not (member font flist))
(setq flist (append font flist))
)
)
)
(setq font nil)
)
)
)
)
(princ flist)
(princ)

Bob
www.bobscadshop.com

 

thank you Bob,

I hoped that it would not be necessary to do that...

It's also necessary to control files to know if it's a font or a compiled
shape.
(read first line should be enought)

it's so simple for ttf ...

(setq obj_wsh (vlax-create-object "WScript.Shell"))
(setq obj_specialfolders (vlax-get obj_wsh 'SpecialFolders))
(setq path_folder_system_font (vlax-invoke obj_specialfolders 'Item
"Fonts"))
(setq files_ttf (vl-directory-files path_folder_system_font "*.ttf" 1)))
(vlax-release-object obj_wsh )
(vlax-release-object obj_specialfolders )


Bruno Toniutti