乱码解决方案------------源码

自贡黄明儒 · 发表于 2013-2-4 16:56:25

本帖最后由自贡黄明儒于 2013-4-1 12:52 编辑

乱码解决方案
看到同事们每打开一个文件时，不断选择gbcbig.shx,我心生怜悯
当然，解决方案有很多种，明经上有源码
1 我修改过acad.fmp文件来满足要求，但总是有很多字体还是找不到。
2 我曾下载过1G以上的字体文件，还是很多字体打不到
3 本方案用gbenor.shx,GBCBIG.shx来代替找不到的字体。4 命令:LMa
欢迎试用
====================================

打开图形时,不显示这个字体替换对话框命令:MyOpen(源码)
;;打开文件时，不出现字体选择对话框自贡黄明儒 2013年2月5日
(defun C:MyOpen (/ *ACAD* DOCOBJ DWGNAME)
  (setq *ACAD* (vlax-get-acad-object))
  (setq DwgName (getfiled "打开文件" (getvar "dwgprefix") "dwg" 0))
  (setq DocObj (vla-open (vla-get-Documents *ACAD*) DwgName))
  (vla-Activate DocObj)
  (if *ACAD* (vlax-release-object *ACAD*))
  (princ)
)

;;源码如下

;;***********************乱码解决方案自贡黄明儒 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日

;;***********************乱码解决方案  自贡黄明儒 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 "<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>" 
  ;; 示例 (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日

我爱lisp · 发表于 2017-8-30 08:47:10

有时候对方图纸的字体设置了宽度，你用替换字体后宽度不一样了，显示效果还是会受影响

不忘初心 · 发表于 2019-12-18 19:01:25

大哥，发个源文件给我如何?付费

sdls · 发表于 2019-3-26 20:56:23

感谢楼主分享

dlczb · 发表于 2013-2-4 17:06:31

乱码解决方案

hao3ren · 发表于 2013-2-4 17:27:07

下载字体不是办法，太多了

crazylsp · 发表于 2013-2-4 17:40:15

乱码是不是用了别人编译过的形文件shp,
是不是形文件浏览器还原成字体文件shx有问题？编译再还原的不再稳定？

显示全部楼层 · 发表于 2013-2-4 17:40:53

提示: 作者被禁止或删除内容自动屏蔽

xiaxiang · 发表于 2013-2-4 17:47:55

回复只为看贴。。。

yjr111 · 发表于 2013-2-4 18:04:30

没有办法解决的，就折腾吧

another2121 · 发表于 2013-2-4 18:09:07

这个好。。要看看

lpl · 发表于 2013-2-4 18:13:10

回复只为看贴。。。

cable2004 · 发表于 2013-2-4 18:28:41

回复只为看贴。。。

账号		自动登录	找回密码
密码			注册

cad3d 该用户已被删除	发表于 2013-2-4 17:40:53 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
cad3d 该用户已被删除
	回复支持反对使用道具举报显身卡

乱码解决方案------------源码

本帖子中包含更多资源

点评

评分

点评