简体繁体转换

;;;=============================================================
;;; 說明：此程序用于繁體字和簡體字的相互轉化，可以用于AutoCAD 的
;;;       字符。實際上簡體字和繁體字并不是一一對應的，有時候可能
;;;       一個簡體字對應多個繁體字，而繁體字一般來說只對應一個簡
;;;       體字。
;;;       程序中GB 碼是指的的中國大陸的簡體中文,GBK 碼是指的的香
;;;       港的繁體中文，BIG5是臺灣的繁體中文。如果應用于CAD 圖形
;;;       轉換，文字中出現問號或者亂碼，可能是由于沒有相應字體的
;;;       支持，請更換文字樣式。譬如:ChineseSet.shx,gbcbig.shx.
;;; 作者：Highflybird
;;; 日期：2013.01.23
;;; 修改：2013.04.20
;;; 地點：中國  深圳
;;;-------------------------------------------------------------
;;; 開源軟件，轉載請注明
;;;=============================================================
;;;=============================================================
;;; 首先確保你做了如下工作:(在winxp以上版本，可能需要管理員權限)
;;; 此函數為是否注冊了插件的檢查
;;; 用vlax-create-object 創建一個實例。用vlax-invoke調用其方法.
;;; 方法有: GB_GBK,GBK_GB,GB_BIG5,BIG5_GB,GBK_BIG5,BIG5_GBK等.
;;; 其功能顧名思義，如：GB_GBK就是把GB簡體轉化為GBK繁體。
;;;=============================================================
(defun Register (/ obj)
  (vl-load-com)
  (if (setq obj (vlax-create-object "CharConverter.Converter"))
    (vlax-release-object obj)
    (if (= (strlen (VL-PRINC-TO-STRING +)) 19)
      (startapp "regsvr32 /s "F:XCharConverter.dll"")     ;把這里面的路徑替換成自己的路徑
      (startapp "regsvr32 /s "F:XCharConverter.x64.dll"") ;如果是64位的系統
    )
  )
)
;;;=============================================================
;;; 功能：用對話框形式轉化兩岸三地的文字
;;;=============================================================
(defun C:DLG (/ Dialog)
  (setq Dialog (vlax-create-object "CharConverter.Dialog"))
  (if Dialog
    (progn
      (vlax-invoke Dialog 'doit)
      (vlax-release-object Dialog)
    )
  )
  (princ)
)
;;;=============================================================
;;; 功能：簡體字符串和繁體字符串互相轉化(此程序為LISP，無需插件)
;;; 輸入：字符串
;;; 輸出：被轉化后的字符串
;;;=============================================================
(defun Text:CharConvert (Converter IsRev text / Index NewTxt Str From to)
  (if IsRev
    (setq From TraditionalCharset
          To SimpleCharSet
    )
    (setq From SimpleCharSet
          To TraditionalCharset
    )
  )
  (setq NewTxt "")
  (while (/= text "")
    (setq str (substr text 1 1))
    (if (> (ascii str) 128)
      (progn
        (setq str (substr text 1 2))
        (setq text (substr text 3))
        (if (setq index (VL-POSITION str From))
          (setq str (nth index To))
        )
      )
      (setq str (substr text 1 1)
            text (substr text 2)
      )
    )
    (setq newtxt (strcat newtxt str))
  )
  newtxt
)
;;;=============================================================
;;; 功能：把含文字實體的CAD圖元進行簡繁轉換
;;; 輸入：含文字實體的CAD圖元
;;; 輸出：被轉化后的CAD圖元
;;;=============================================================
(defun ConvertEntity (Ent Converter How / dxf obj typ txt name blk TMPLST d)
  (setq dxf (entget ent))
  (setq obj (vlax-ename->vla-object ent))
  (setq Typ (cdr (assoc 0 dxf)))
  (cond
    ( (vlax-property-available-p obj 'textstring)               ;單行文字，多行文字，容差等等。
      (setq txt (vla-get-TextString obj))                       ;取得文字內容
      (vla-put-textstring obj (Func Converter How txt))         ;修改文字內容
      (if (= Typ "ATTDEF")
        (progn
          (setq txt (vla-get-tagstring obj))
          (vla-put-tagstring obj (Func Converter How txt))
        )
      )
    )
    ( (vlax-property-available-p obj 'TextOverride)             ;尺寸標注
      (setq txt (vla-get-TextOverride obj))                     ;取得文字內容
      (vla-put-TextOverride obj (Func Converter How txt))       ;修改文字內容
    )
    ( (= Typ "ACAD_TABLE")                                      ;表格
      (setq TMPLST  nil)
      (foreach n dxf                                            ;此處用DXF表(用vla方法比較啰嗦)
        (setq d (car n))
        (if (or (= d 1) (= d 3))
          (setq txt (Func Converter How (cdr n))                ;取得并修改文字內容
                TMPLST (cons (cons d txt) TMPLST)
          )
          (setq TMPLST (cons n TMPLST ))
        )
      )
      (entmod (reverse TMPLST))
      (vla-update obj)                                          ;需要更新一下
    )
    ( (= Typ "INSERT")                                          ;對于插入塊
      (foreach Att (vlax-invoke obj 'GetAttributes)
        (setq txt (vla-get-tagstring Att))
        (vla-put-tagstring Att (Func Converter How txt))
        (setq txt (vla-get-textstring Att))
        (vla-put-textstring Att (Func Converter How txt))
      )
      (setq name (vla-get-name obj))                            ;取得塊名
      (setq blk (vla-item *BLK name))
      (vlax-for n blk
        (ConvertEntity (vlax-vla-object->ename n) Converter How);遞歸進去，用于處理嵌套
      )
      (vla-update obj)                                          ;需要更新一下
    )
  )
)
;;;=============================================================
;;; 測試程序一，把一個文本文件里面的文字進行簡繁轉化
;;;=============================================================
(defun C:TT (/ BASE EXTN FILE KEY NAME OUTFILE PATH STR How OBJ LNG)
  (setq STR "(1)GB->GBK;(2)GBK->GB;(3)GB->BIG5;(4)BIG5->GB;(5)GBK->BIG5;(6)BIG5->GBK")
  (setq LNG (getvar 'locale))
  (cond
    ( (= LNG "CHS") (setq STR (strcat "请选择方式: " STR "<默认>")))
    ( (= LNG "CHT") (setq STR (strcat "叫匡拒よΑ: " STR "<纐粄>")))
    ( T (setq STR (strcat "請選擇方式: " STR "<默認>")))
  )
  (initget "1 2 3 4 5 6 S T")
  (setq key (getkword STR))
  (setq name (getfiled "Select a text File" (getvar 'DWGPREFIX) "*" 0))
  (if (and name (setq file (open name "R")))
    (progn
      (cond
        ( (= key "1") (setq How 'GB_GBK))
        ( (= key "2") (setq How 'GBK_GB))
        ( (= key "3") (setq How 'GB_BIG5))
        ( (= key "4") (setq How 'BIG5_GB))
        ( (= key "5") (setq How 'GBK_BIG5))
        ( (= key "6") (setq How 'BIG5_GBK))
        ( (= key "S") (setq How nil))
        ( (= key "T") (setq How T))
        ( t (setq How 'GB_GBK))
      )
      (setq path (vl-filename-directory name))
      (setq extn (vl-filename-extension name))
      (setq base (vl-filename-base name))
      (and (null extn) (setq extn ""))
      (setq outfile (open (strcat path "" base "轉" extn) "w"))
      (setq obj (vlax-create-object "CharConverter.converter"))
      (while (setq str (read-line file))
        ;;(setq str (Text:CharConvert nil How str))            ;如果你不用插件，可以用此方式
        (setq str (vlax-invoke obj How str))
        (write-line str Outfile)
      )
      (close outfile)
      (close file)
      (vlax-release-object obj)
      (princ)
    )
  )
)
;;;=============================================================
;;; 測試程序二，把選中的CAD文本簡繁轉化(需要先注冊插件)
;;; 當然你也可稍加修改，就能把標注，表格，及符號表的說明等轉化。
;;;=============================================================
(defun C:Test (/ i key Sel Ent *DOC *BLK How CONVERTER LNG STR FUNC)
  (setq STR "(1)GB->GBK;(2)GBK->GB;(3)GB->BIG5;(4)BIG5->GB;(5)GBK->BIG5;(6)BIG5->GBK")
  (setq LNG (getvar 'locale))
  (cond
    ( (= LNG "CHS") (setq STR (strcat "请选择方式: " STR "<默认>")))
    ( (= LNG "CHT") (setq STR (strcat "叫匡拒よΑ: " STR "<纐粄>")))
    ( T (setq STR (strcat "請選擇方式: " STR "<默認>")))
  )
  (initget "1 2 3 4 5 6 S T")
  (setq key (getkword STR))
  (if (setq sel (ssget '((0 . "*TEXT,INSERT,ATTDEF,TOLERANCE,DIMENSION,ACAD_TABLE"))))
    (progn
      (cond
        ( (= key "1") (setq How 'GB_GBK))
        ( (= key "2") (setq How 'GBK_GB))
        ( (= key "3") (setq How 'GB_BIG5))
        ( (= key "4") (setq How 'BIG5_GB))
        ( (= key "5") (setq How 'GBK_BIG5))
        ( (= key "6") (setq How 'BIG5_GBK))
        ( (= key "S") (setq How nil))
        ( (= key "T") (setq How T))
        ( t (setq How 'GB_GBK))
      )
      (setq *DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq *BLK (vla-get-blocks *DOC))
      (setq Converter (vlax-create-object "CharConverter.converter"))
      (if Converter
        (setq Func vlax-invoke)                                 ;如果加載了插件，則可以用invoke方式
        (setq Func Text:CharConvert)                            ;實際上此處函數可自定，不僅是簡繁轉換
      )
      (vla-StartUndoMark *DOC)
      (setq i 0)
      (repeat (sslength sel)
        (setq ent (ssname sel i))
        (ConvertEntity Ent converter How)
        (setq i (1+ i))
      )
      (vla-EndUndoMark *DOC)
      (vlax-release-object converter)
      (vlax-release-object *DOC)
      (princ "n轉化完畢，請驗證!")
    )
  )
  (princ)
)
;;;=============================================================
;;;漢字轉化字符表
;;;=============================================================
;;;=============================================================
;;; 以下程序用于格式化簡繁字庫
;;; 如果你想要添加本程序中沒有的字庫，請按照一一對應的方式添加
;;;=============================================================
(defun C:FormatSet (/ A1 A2 F1 F2 F3 F4 I L1 L2 S1 S2)
  (setq f1 (open "f:zqylsp簡體字.txt" "R"))
  (setq f2 (open "f:zqylsp繁體字.txt" "R"))
  (setq f3 (open "f:zqylspSimpleList.txt" "w"))
  (setq f4 (open "f:zqylspTraditionalList.txt" "w"))
  (setq i 0)
  (setq l1 nil)
  (while (setq s1 (read-line f1))
    (while (/= (setq a1 (substr s1 1 2)) "")
      (and (zerop (rem i 20)) (princ "n" f3))
      (princ (vl-string->list a1) f3)
      (setq l1 (cons a1 l1))
      (setq s1 (substr s1 3))
      (setq i (1+ i))
    )
  )
  (setq i 0)
  (setq l2 nil)
  (while (setq s2 (read-line f2))
    (while (/= (setq a2 (substr s2 1 2)) "")
      (and (zerop (rem i 20)) (princ "n" f4))
      (princ (vl-string->list a2) f4)
      (setq l2 (cons a2 l2))
      (setq s2 (substr s2 3))
      (setq i (1+ i))
    )
  )
  ;(setq l1 (ACAD_STRLSORT l1))
  ;(setq l2 (ACAD_STRLSORT l2))
  (close f1)
  (close f2)
  (close f3)
  (close f4)
  (princ)
)
;;;下面代碼用于測試
;;;(MISC:Test 1000 '( (Text:CharConvert txt IsRev) (vlax-invoke Converter How txt)))
(defun C:test2 (/ f obj)
  (setq obj (vlax-create-object "CharConverter.converter"))
  (vlax-invoke obj 'BIG5_GB "い地チ㎝瓣")
  (vlax-invoke obj 'GBK_BIG5 "中華人民共和國")
  (vlax-invoke obj 'GB_GBK "中华人民共和国")
  (vlax-invoke obj 'GBK_GB "中華人民共和國")
  (vlax-invoke obj 'BIG5_GBK "い地チ㎝瓣")
  (vlax-invoke obj 'GBK_BIG5 "中華人民共和國")
  (setq f (open "d:/temp/1.txt" "W"))
  (write-line (vlax-invoke obj 'GB_Big5 "中华人民共和国") f)
  (close f)
  (vlax-release-object obj)
)
;;; 注冊加載
(Register)
(princ "nTT   --轉換文本文件,nTest --轉換含文本的CAD圖元,nDLG  --對話框形式轉換.這幾個命令可自行修改.")
(princ)