
;导出图中所有字库文件[mini_Export_Fonts].lsp

(defun C:mini_Export_Fonts ( / ee old_cmd sPath lstFonts e lstExist lstNoFind sPrompt WinPath sFontPath)
  
	(mai_start nil)
	(mai_last_com "mini_Export_Fonts")
	(setq sPath (mai_getdir "选出字体字库文件导出目录" mai_mini_path))
	(or sPath (exit))
	(setq
		WinPath (strcat (getenv "Windir") "\\FONTS\\")	;Windows 目录
		lstFonts (apply 'append (mapcar 'mai_style_fonts (mai_tblsearch "style")))
		lstFonts (mai_remove_same (vl-remove-if 'mai_not_str lstFonts))
	)
	(foreach e lstFonts
		(setq ee nil)
		(if (wcmatch (strcase e) "*.TTC")
			(setq ee (vl-string-subst ".TTC" ".TTF" (strcase e)))
		)
		(if (or (findfile (strcat sPath e))
				(and ee (findfile (strcat sPath ee)))
			)
			(setq lstExist (cons e lstExist))
			(if (or (setq sFontPath (findfile e))	;CAD路径中未找到
					(setq sFontPath (findfile (strcat WinPath e)))	;搜索Windows字体目录
					(and ee (setq sFontPath (findfile (strcat WinPath ee))))	;将TFF换成TTC再次搜索
				)
				(vl-file-copy
					sFontPath
					(if (wcmatch (strcase sFontPath) "*.TTC")
						(strcat sPath (vl-string-right-trim "fF" e) "F")
						(strcat sPath e)
					)
					nil
				)
				(setq lstNoFind (cons e lstNoFind))
			);end if
		)
	)
	(setq
		sPrompt
			(strcat
				"\n本图共使用字体【"
				(itoa (length lstFonts))
				"个】,其中【"
				(itoa (length lstExist))
				"个】已存在于目录中，【"
				(itoa (length lstNoFind))
				"个】字体未找到"
			)
	)
	(if lstNoFind (setq sPrompt (strcat sPrompt "\n未找到的字体有【" (mai_lst2str lstNoFind ";") "】。")))
	; (alert sPrompt)
	(princ sPrompt)
	(mai_dos_execute (strcat "\"" sPath "\"") nil)
	(mai_end)
)
