明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 61746|回复: 518

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

    [复制链接]
发表于 2013-2-4 16:56 | 显示全部楼层 |阅读模式
本帖最后由 自贡黄明儒 于 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)
)

;;源码如下
  1. ;;***********************乱码解决方案  自贡黄明儒 2013年2月4日
  2. (defun ChaosWords
  3.        (/ *ACAD* *DOC* *DOCS* DWGFILES DWGPATH FILELST NOTOPENFILE OPENFILELST RETURN#)
  4.   ;;1 检查文件能否打开
  5.   (defun CanSuccessOpen (DwgName / ACADAPP CATCHIT DBXDOC)
  6.     (setq AcadApp (vlax-get-acad-object)
  7.    dbxDoc  (vla-GetInterfaceObject
  8.       AcadApp
  9.       (GetObjectDBXVer)
  10.     )
  11.     )
  12.     (setq catchit (vl-catch-all-apply 'vla-open (list dbxDoc DwgName)))
  13.     (if dbxDoc
  14.       (vlax-release-object dbxDoc)
  15.     )           ;关闭文档
  16.     (if AcadApp
  17.       (vlax-release-object AcadApp)
  18.     )
  19.     (vl-catch-all-error-p catchit)
  20.   )
  21.   ;;2 文字替代(解决文字乱码用)
  22.   (defun ChaosWords1 (doc / BIGFILE FONTFILE TXTSTYLES)
  23.     (setq txtstyles (vla-get-textstyles doc))
  24.     (vlax-for txtstyle txtstyles
  25.       (setq fontfile (vla-get-fontfile txtstyle))
  26.       (if (findfile fontfile)
  27. nil
  28. (vla-put-fontfile txtstyle "gbenor.shx")
  29.       )
  30.       (setq bigfile (vla-get-bigfontfile txtstyle))
  31.       (if (findfile bigfile)
  32. nil
  33. (vla-put-bigfontfile txtstyle "GBCBIG.shx")
  34.       )
  35.     )
  36.   )
  37.   ;;3 对象名称
  38.   ;; 示例 (MJ:Name *ACAD*) returns "AutoCAD"
  39.   ;; 示例 (MJ:Name *MS*)返回"*Model_Space"
  40.   (defun MJ:Name (obj)
  41.     (if (vlax-property-available-p obj 'Name)
  42.       (vlax-get-property obj 'Name)
  43.       "<NONE_NAME>"
  44.     )
  45.   )
  46.   ;;4 (打开文件 未打开文件)列表
  47.   ;;示例(car (MJ:DocsList1 DwgFileLst))取得列表文件中打开的文件列表
  48.   (defun MJ:DocsList1 (DwgFileLst / OPENFILELST)
  49.     (list (vl-remove-if 'VL-FILE-SYSTIME DwgFileLst)
  50.    (vl-remove-if-not 'VL-FILE-SYSTIME DwgFileLst)
  51.     )
  52.   )
  53.   ;;5.1 列表中的文件如果已经打开
  54.   (defun OpenFileDo (OpenFileLst / FILEPATH)
  55.     (vlax-for each (vla-get-Documents *ACAD*)
  56.       (setq FilePath (strcat (vlax-get-property each 'Path) "\\" (MJ:Name each)))
  57.       (if (member (strcase FilePath) OpenFileLst)
  58. (progn (ChaosWords1 each) (vla-regen each acActiveViewport))
  59.       )
  60.     )
  61.   )
  62.   ;;5.2 非打开的文件列表消除乱码
  63.   (defun NotOpenFileDo (NotOpenFile / DOCOBJ DWGNAME INDEX)   
  64.     (repeat (setq Index (length NotOpenFile))
  65.       (setq DwgName (nth (setq Index (1- Index)) NotOpenFile))
  66.       (if (CanSuccessOpen DwgName)
  67. nil
  68. (progn
  69.    (setq DocObj (vla-open (vla-get-Documents *ACAD*) DwgName))
  70.    (ChaosWords1 DocObj)
  71.    (vla-saveas DocObj DwgName)
  72.    (vla-close DocObj :vlax-true)
  73. )
  74.       )
  75.     )
  76.     (if DocObj
  77.       (vlax-release-object DocObj)
  78.     )   
  79.   )
  80.   ;;7 对话框 return#
  81.   (defun ChaosDCL (/ DCLID FN FNAME LIN)
  82.     (setq fname (vl-filename-mktemp nil nil ".dcl"))
  83.     (setq fn (open fname "w"))
  84.     (write-line "ChaosWords : dialog {" fn)
  85.     (write-line "label=\"*****[乱码解决]****自贡黄明儒\";" fn)
  86.     (write-line ":column{" fn)
  87.     (write-line " :button{label=\"仅仅当前激活文件(&A)\";key=\"button1\";}" fn)
  88.     (write-line " :button{label=\"打开的所有文件   (&B)\";key=\"button2\";}" fn)
  89.     (write-line " :button{label=\"当前文件所在目录下所有文件   (&C)\";key=\"button3\";}"
  90.   fn
  91.     )
  92.     (write-line
  93.       " :button {label = \"文件所在及其子目录下所有文件(&D)\";key = \"button4\";is_default=true;}"
  94.       fn
  95.     )
  96.     (write-line " :button {label = \"取    消(&E)\";key = \"but_Cancel\";is_cancel = true;}"
  97.   fn
  98.     )
  99.     (write-line " } " fn)
  100.     (write-line "}" fn)
  101.     (close fn)
  102.     (setq fn (open fname "r"))
  103.     (setq dclid (load_dialog fname))
  104.     (while (or (eq (substr (setq lin
  105.       (vl-string-right-trim "\" fn)"
  106.        (vl-string-left-trim "(write-line \"" (read-line fn))
  107.       )
  108.       )
  109.       1
  110.       2
  111.      )
  112.      "//"
  113.         )
  114.         (eq (substr lin 1 (vl-string-search " " lin)) "")
  115.         (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))
  116.     )
  117.     )
  118.     (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
  119.     (action_tile "button1" "(done_dialog 1)")
  120.     (action_tile "button2" "(done_dialog 2)")
  121.     (action_tile "button3" "(done_dialog 3)")
  122.     (action_tile "button4" "(done_dialog 4)")
  123.     (action_tile "but_Cancel" "(done_dialog 0)")
  124.     (setq return# (start_dialog))
  125.     (unload_dialog dclid)
  126.     (close fn)
  127.     (vl-file-delete fname)
  128.   )
  129.   ;;8 本程序主程序
  130.   (setq *ACAD* (vlax-get-acad-object)
  131. *DOC*  (vla-get-ActiveDocument *ACAD*)
  132. *DOCS* (vla-get-Documents *ACAD*)
  133.   )
  134.   (ChaosDCL)
  135.   (cond
  136.     ((equal return# 1)         ;仅仅当前激活文档消除乱码
  137.      (ChaosWords1 *DOC*)
  138.      (vla-regen *DOC* acActiveViewport)
  139.     )
  140.     ((equal return# 2)         ;所有的打开文件消除乱码
  141.      (vlax-for each *DOCS* (ChaosWords1 each) (vla-regen each acActiveViewport))
  142.     )
  143.     ((or (equal return# 3) (equal return# 4))
  144.      (setq dwgPath (strcat (vlax-get-property *DOC* 'Path) "\\"))
  145.      (cond ((equal return# 3) (setq dwgfiles (GetAllSpecFilesInFolder dwgPath "*.dwg")))
  146.     ((equal return# 4) (setq dwgfiles (GetAllSpecFilesInFolders dwgPath "*.dwg")))
  147.      )
  148.      (setq filelst (MJ:DocsList1 dwgfiles))
  149.      (setq OpenFileLst (car filelst))
  150.      (setq NotOpenFile (cadr filelst))
  151.      (if OpenFileLst
  152.        (progn (setq OpenFileLst (mapcar 'strcase OpenFileLst))
  153.        (OpenFileDo OpenFileLst)
  154.        )
  155.      )
  156.      (if NotOpenFile
  157.        (NotOpenFileDo NotOpenFile)
  158.      )
  159.     )
  160.   )
  161.   (if *ACAD*
  162.     (vlax-release-object *ACAD*)
  163.   )
  164.   (princ)
  165. )
  166. ;;***********************乱码解决方案  自贡黄明儒 2013年2月4日






本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

对黄大师说:猛然回头,那程序却在灯火阑珊处呢!厉害  发表于 2017-8-30 08:46
矢量字体有时候用 (vla-get-fontfile txtstyle)读取出来是“”被强制替换了,还有些没有大字体的也被替换了。能解决这两个问题就好了。  发表于 2015-4-2 20:47
矢量字体即使存在也会被替代,请修正  发表于 2014-9-29 11:00
不好意思,说错了,是用上面的MYOPEN不行,下面的源码可行,谢谢楼主  发表于 2014-1-20 22:18
大哥,用了一下源码,不行了,用打包的VLX文件可以  发表于 2014-1-20 21:21
这个很给力!  发表于 2013-9-26 20:16
建议黄工再进化,可选择设置用此命令替代原CAD中的打开命令,这样不用每次加载这个程序啊,你很牛哈  发表于 2013-2-6 10:29

评分

参与人数 1明经币 +1 收起 理由
lohas1118 + 1 神马都是浮云

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2017-8-30 08:47 | 显示全部楼层
有时候对方图纸的字体设置了宽度,你用替换字体后宽度不一样了,显示效果还是会受影响
发表于 2019-12-18 19:01 | 显示全部楼层
大哥,发个源文件给我如何?付费
发表于 2019-3-26 20:56 | 显示全部楼层
感谢楼主分享
发表于 2013-2-4 17:06 | 显示全部楼层
乱码解决方案
发表于 2013-2-4 17:27 | 显示全部楼层
下载字体不是办法,太多了
发表于 2013-2-4 17:40 | 显示全部楼层
乱码是不是用了别人编译过的形文件shp,
是不是形文件浏览器还原成字体文件shx有问题?编译再还原的不再稳定?
cad3d 该用户已被删除
发表于 2013-2-4 17:40 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
发表于 2013-2-4 17:47 | 显示全部楼层
回复只为看贴。。。
发表于 2013-2-4 18:04 | 显示全部楼层
没有办法解决的,就折腾吧

点评

是啊,基本无效  发表于 2013-4-8 16:34
发表于 2013-2-4 18:09 | 显示全部楼层
这个好。。要看看
发表于 2013-2-4 18:13 | 显示全部楼层
回复只为看贴。。。
发表于 2013-2-4 18:28 | 显示全部楼层
回复只为看贴。。。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 01:31 , Processed in 0.259937 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表