ChaosWords文字乱码

/db_自贡黄明儒_ · 发表于 2016-9-1 14:05:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2016-9-1 14:06 编辑

今天整理了一下当年发在明经的“ChaosWords文字乱码”

;;***********************乱码解决方案自贡黄明儒 2013年2月4日
(defun ChaosWords (/ CanSuccessOpen ChaosWords1MJ:Name MJ:DocsList1 OpenFileDo NotOpenFileDo ChaosDCL 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)))
(cond (dbxDoc (vlax-release-object dbxDoc))) ;关闭文档
(cond (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))
(cond ((not (findfile fontfile)) (vla-put-fontfile txtstyle "gbenor.shx")))
(setq bigfile (vla-get-bigfontfile txtstyle))
(cond ((not (findfile bigfile)) (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)))
(cond ((member (strcase FilePath) OpenFileLst)
(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))
(cond ((not (CanSuccessOpen DwgName))
(setq DocObj (vla-open (vla-get-Documents *ACAD*) DwgName))
(ChaosWords1 DocObj)
(vla-saveas DocObj DwgName)
(vla-close DocObj :vlax-true)
)
)
)
(cond (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))
(new_dialog "ChaosWords" 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 本程序主程序
(or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
(or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
(or *DOCS* (setq *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))
(cond (OpenFileLst
(setq OpenFileLst (mapcar 'strcase OpenFileLst))
(OpenFileDo OpenFileLst)
)
)
(cond (NotOpenFile (NotOpenFileDo NotOpenFile)))
)
)
(princ)
)
;;***********************乱码解决方案自贡黄明儒 2013年2月4日

;;***********************乱码解决方案  自贡黄明儒 2013年2月4日 
(defun ChaosWords (/ CanSuccessOpen ChaosWords1MJ:Name MJ:DocsList1 OpenFileDo NotOpenFileDo ChaosDCL 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))) 
    (cond (dbxDoc (vlax-release-object dbxDoc)))            ;关闭文档 
    (cond (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)) 
      (cond ((not (findfile fontfile)) (vla-put-fontfile txtstyle "gbenor.shx"))) 
      (setq bigfile (vla-get-bigfontfile txtstyle)) 
      (cond ((not (findfile bigfile)) (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))) 
      (cond ((member (strcase FilePath) OpenFileLst) 
             (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)) 
      (cond ((not (CanSuccessOpen DwgName)) 
             (setq DocObj (vla-open (vla-get-Documents *ACAD*) DwgName)) 
             (ChaosWords1 DocObj) 
             (vla-saveas DocObj DwgName) 
             (vla-close DocObj :vlax-true) 
            ) 
      ) 
    ) 
    (cond (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)) 
    (new_dialog "ChaosWords" 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 本程序主程序 
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object))) 
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*))) 
  (or *DOCS* (setq *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)) 
     (cond (OpenFileLst 
            (setq OpenFileLst (mapcar 'strcase OpenFileLst)) 
            (OpenFileDo OpenFileLst) 
           ) 
     ) 
     (cond (NotOpenFile (NotOpenFileDo NotOpenFile))) 
    ) 
  ) 
  (princ) 
) 
;;***********************乱码解决方案  自贡黄明儒 2013年2月4日

游客，如果您要查看本帖隐藏内容请回复

lisp_beginner · 发表于 2016-9-1 14:13:23

回复学习，谢谢

HLCAD · 发表于 2016-9-1 15:56:24

好好学习一下，谢谢

HLCAD · 发表于 2016-9-1 16:07:09

缺少函数：GetObjectDBXVer

/db_自贡黄明儒_ · 发表于 2016-9-1 16:11:09

HLCAD 发表于 2016-9-1 16:07
缺少函数：GetObjectDBXVer

(defun GetObjectDBXVer (/ VERSION)
(if (>= (setq VERSION (atoi (getvar "acadver"))) 16)
(strcat "ObjectDBX.AxDbDocument." (itoa VERSION))
)
)

lucas3 · 发表于 2016-9-1 23:49:59

黄大，又更新了什么？

q3_2006 · 发表于 2016-9-2 11:50:30

不知道是不是真能解决乱码问题..

yoyoho · 发表于 2016-9-2 15:33:24

回复学习一下，谢谢黃老師!!!!

casd · 发表于 2017-6-15 07:26:46

学习大做，支持

laiz3000 · 发表于 2017-6-16 10:51:16

这个功能不错

shpdzhj · 发表于 2018-5-17 17:25:39

好好学习一下，谢谢

sicky111 · 发表于 2018-5-18 07:07:45

回复看源码！

konoko520 · 发表于 2018-5-18 10:13:57

谢谢黄大师分享！！！

caogis · 发表于 2018-9-29 15:00:21

黄ChaosWords文字乱码

woshilj · 发表于 2019-3-27 16:35:32

感谢分享，下载来试试看能否解决问题

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

[每日一码] ChaosWords文字乱码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评