乱码解决方案------------源码
本帖最后由 自贡黄明儒 于 2013-4-1 12:52 编辑乱码解决方案
看到同事们每打开一个文件时，不断选择gbcbig.shx,我心生怜悯
当然，解决方案有很多种，明经上有源码
1 我修改过acad.fmp文件来满足要求，但总是有很多字体还是找不到。
2 我曾下载过1G以上的字体文件，还是很多字体打不到
3 本方案用gbenor.shx,GBCBIG.shx来代替找不到的字体。4 命令:LMa
**** Hidden Message *****
====================================
打开图形时,不显示这个字体替换对话框 命令:MyOpen(源码)
**** Hidden Message *****
;;源码如下
;;***********************乱码解决方案自贡黄明儒 2013年2月4日
(defun ChaosWords
(/ *ACAD* *DOC* *DOCS* DWGFILES DWGPATH FILELST NOTOPENFILE OPENFILELST RETURN#)
;;1 检查文件能否打开
(defun CanSuccessOpen (DwgName / ACADAPP CATCHIT DBXDOC)
(setq AcadApp (vlax-get-acad-object)
dbxDoc(vla-GetInterfaceObject
AcadApp
(GetObjectDBXVer)
)
)
(setq catchit (vl-catch-all-apply 'vla-open (list dbxDoc DwgName)))
(if dbxDoc
(vlax-release-object dbxDoc)
) ;关闭文档
(if AcadApp
(vlax-release-object AcadApp)
)
(vl-catch-all-error-p catchit)
)
;;2 文字替代（解决文字乱码用）
(defun ChaosWords1 (doc / BIGFILE FONTFILE TXTSTYLES)
(setq txtstyles (vla-get-textstyles doc))
(vlax-for txtstyle txtstyles
(setq fontfile (vla-get-fontfile txtstyle))
(if (findfile fontfile)
nil
(vla-put-fontfile txtstyle "gbenor.shx")
)
(setq bigfile (vla-get-bigfontfile txtstyle))
(if (findfile bigfile)
nil
(vla-put-bigfontfile txtstyle "GBCBIG.shx")
)
)
)
;;3 对象名称
;; 示例 (MJ:Name *ACAD*) returns "AutoCAD"
;; 示例 (MJ:Name *MS*)返回"*Model_Space"
(defun MJ:Name (obj)
(if (vlax-property-available-p obj 'Name)
(vlax-get-property obj 'Name)
"<NONE_NAME>"
)
)
;;4 (打开文件 未打开文件)列表
;;示例(car (MJ:DocsList1 DwgFileLst))取得列表文件中打开的文件列表
(defun MJ:DocsList1 (DwgFileLst / OPENFILELST)
(list (vl-remove-if 'VL-FILE-SYSTIME DwgFileLst)
(vl-remove-if-not 'VL-FILE-SYSTIME DwgFileLst)
)
)
;;5.1 列表中的文件如果已经打开
(defun OpenFileDo (OpenFileLst / FILEPATH)
(vlax-for each (vla-get-Documents *ACAD*)
(setq FilePath (strcat (vlax-get-property each 'Path) "\\" (MJ:Name each)))
(if (member (strcase FilePath) OpenFileLst)
(progn (ChaosWords1 each) (vla-regen each acActiveViewport))
)
)
)
;;5.2 非打开的文件列表消除乱码
(defun NotOpenFileDo (NotOpenFile / DOCOBJ DWGNAME INDEX)
(repeat (setq Index (length NotOpenFile))
(setq DwgName (nth (setq Index (1- Index)) NotOpenFile))
(if (CanSuccessOpen DwgName)
nil
(progn
(setq DocObj (vla-open (vla-get-Documents *ACAD*) DwgName))
(ChaosWords1 DocObj)
(vla-saveas DocObj DwgName)
(vla-close DocObj :vlax-true)
)
)
)
(if DocObj
(vlax-release-object DocObj)
)
)
;;7 对话框 return#
(defun ChaosDCL (/ DCLID FN FNAME LIN)
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "ChaosWords : dialog {" fn)
(write-line "label=\"*****[乱码解决]****自贡黄明儒\";" fn)
(write-line ":column{" fn)
(write-line " :button{label=\"仅仅当前激活文件(&A)\";key=\"button1\";}" fn)
(write-line " :button{label=\"打开的所有文件 (&B)\";key=\"button2\";}" fn)
(write-line " :button{label=\"当前文件所在目录下所有文件 (&C)\";key=\"button3\";}"
fn
)
(write-line
" :button {label = \"文件所在及其子目录下所有文件(&D)\";key = \"button4\";is_default=true;}"
fn
)
(write-line " :button {label = \"取 消(&E)\";key = \"but_Cancel\";is_cancel = true;}"
fn
)
(write-line " } " fn)
(write-line "}" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while (or (eq (substr (setq lin
(vl-string-right-trim "\" fn)"
(vl-string-left-trim "(write-line \"" (read-line fn))
)
)
1
2
)
"//"
)
(eq (substr lin 1 (vl-string-search " " lin)) "")
(not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))
)
)
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(action_tile "button1" "(done_dialog 1)")
(action_tile "button2" "(done_dialog 2)")
(action_tile "button3" "(done_dialog 3)")
(action_tile "button4" "(done_dialog 4)")
(action_tile "but_Cancel" "(done_dialog 0)")
(setq return# (start_dialog))
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
)
;;8 本程序主程序
(setq *ACAD* (vlax-get-acad-object)
*DOC*(vla-get-ActiveDocument *ACAD*)
*DOCS* (vla-get-Documents *ACAD*)
)
(ChaosDCL)
(cond
((equal return# 1) ;仅仅当前激活文档消除乱码
(ChaosWords1 *DOC*)
(vla-regen *DOC* acActiveViewport)
)
((equal return# 2) ;所有的打开文件消除乱码
(vlax-for each *DOCS* (ChaosWords1 each) (vla-regen each acActiveViewport))
)
((or (equal return# 3) (equal return# 4))
(setq dwgPath (strcat (vlax-get-property *DOC* 'Path) "\\"))
(cond ((equal return# 3) (setq dwgfiles (GetAllSpecFilesInFolder dwgPath "*.dwg")))
((equal return# 4) (setq dwgfiles (GetAllSpecFilesInFolders dwgPath "*.dwg")))
)
(setq filelst (MJ:DocsList1 dwgfiles))
(setq OpenFileLst (car filelst))
(setq NotOpenFile (cadr filelst))
(if OpenFileLst
(progn (setq OpenFileLst (mapcar 'strcase OpenFileLst))
(OpenFileDo OpenFileLst)
)
)
(if NotOpenFile
(NotOpenFileDo NotOpenFile)
)
)
)
(if *ACAD*
(vlax-release-object *ACAD*)
)
(princ)
)
;;***********************乱码解决方案自贡黄明儒 2013年2月4日
有时候对方图纸的字体设置了宽度，你用替换字体后宽度不一样了，显示效果还是会受影响 大哥，发个源文件给我如何?付费 感谢楼主分享 乱码解决方案 下载字体不是办法，太多了 乱码是不是用了别人编译过的形文件shp,
是不是形文件浏览器还原成字体文件shx有问题？编译再还原的不再稳定？ 回复只为看贴。。。 没有办法解决的，就折腾吧 这个好。。要看看 回复只为看贴。。。 回复只为看贴。。。