[求助]如何转换将图面上繁体字或简体字互转呢?

vken7az2p

如何转换将图面上繁体字或简体字互转呢?
烦请各位高手帮忙解答一下
谢谢!

mccad

需要互换表，然后一个文字一个文字替换。程序可能简单，但字码互换表比较麻烦

vken7az2p

再请问一下
那该怎样将 取得文字内容的
16进位 Unicode 转换成为
ASCII 十六进位
或
ASCII 十进位
呢?

烦请各位高手帮忙解答一下
谢谢!

vken7az2p

mccad发表于2008-9-8 21:18:00需要互换表，然后一个文字一个文字替换。程序可能简单，但字码互换表比较麻烦

该怎样建立字码互换表呢?

烦请各位高手帮忙解答一下
谢谢!

mccad

这是三年前写的一个简单的程序，附件中有对照字符表，应该是做为简体转繁体或繁体转简体用。

2. Option Explicit
3.    
4. Sub Main()
5.     Dim Str As String
6.     Dim tmpStr As String
7.     Str = "a宁静的夏天，天空中繁星点点，心里头有些思念，思念着你的脸。"
8.     tmpStr = ChtToChs(Str)
9.     ThisDrawing.ModelSpace(0).TextString = tmpStr
10.     ThisDrawing.ModelSpace(1).TextString = Str
11. End Sub
12. Function ChtToChs(Str As String) As String
13.     Dim i As Long
14.     Dim tmpStr As String
15.     Dim s  As String
16.     Dim StrList As Variant
17.     StrList = GetStrList
18.     For i = 1 To Len(Str)
19.         s = Mid(Str, i, 1)
20.         If Asc(s) <= -2050 Then
21.             s = Chr(StrList(Asc(s) + 24159))
22.         End If
23.         tmpStr = tmpStr & s
24.     Next
25.     ChtToChs = tmpStr
26. End Function
27. Function Cht2Chs(Str As String) As String
28.     Dim i As Long
29.     Dim j  As Long
30.     Dim tmpStr As String
31.     Dim s  As String
32.     For i = 1 To Len(Str)
33.         s = Mid(Str, i, 1)
34.         For j = 1 To Len(ChsStr)
35.             If s = Mid(ChsStr, j, 1) Then
36.                 s = Mid(ChtStr, j, 1)
37.                 Exit For
38.             End If
39.         Next
40.         tmpStr = tmpStr & s
41.     Next
42.     Cht2Chs = tmpStr
43. End Function
44. Function GetStrList() As Variant
45.     Dim StrList(22109) As Long
46.     Dim i As Long
47.     Dim ChsStr As String
48.     Dim ChtStr As String
49.     ChsStr = GetStr(True)
50.     ChtStr = GetStr(False)
51.     For i = 1 To Len(ChsStr)
52.         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
53.     Next
54.     GetStrList = StrList
55. End Function
56. Function GetStr(isChs As Boolean) As String
57.     Dim strFile As String
58.     Dim strPath As String
59.     Dim strText As String
60.     strFile = VBE.ActiveVBProject.FileName
61.     strPath = Left(strFile, InStrRev(strFile, ""))
62.     If isChs Then
63.         strFile = "chsstr.dat"
64.     Else
65.         strFile = "chtstr.dat"
66.     End If
67.         Open strPath & strFile For Input As #1
68.     Do Until EOF(1)
69.         Line Input #1, strText
70.         GetStr = GetStr & strText
71.     Loop
72.     Close #1
73. End Function

Option Explicit     Sub Main()     Dim Str As String     Dim tmpStr As String     Str = "a宁静的夏天，天空中繁星点点，心里头有些思念，思念着你的脸。"     tmpStr = ChtToChs(Str)     ThisDrawing.ModelSpace(0).TextString = tmpStr     ThisDrawing.ModelSpace(1).TextString = Str End Sub Function ChtToChs(Str As String) As String     Dim i As Long     Dim tmpStr As String     Dim s  As String     Dim StrList As Variant     StrList = GetStrList     For i = 1 To Len(Str)         s = Mid(Str, i, 1)         If Asc(s) <= -2050 Then             s = Chr(StrList(Asc(s) + 24159))         End If         tmpStr = tmpStr & s     Next     ChtToChs = tmpStr End Function Function Cht2Chs(Str As String) As String     Dim i As Long     Dim j  As Long     Dim tmpStr As String     Dim s  As String     For i = 1 To Len(Str)         s = Mid(Str, i, 1)         For j = 1 To Len(ChsStr)             If s = Mid(ChsStr, j, 1) Then                 s = Mid(ChtStr, j, 1)                 Exit For             End If         Next         tmpStr = tmpStr & s     Next     Cht2Chs = tmpStr End Function Function GetStrList() As Variant     Dim StrList(22109) As Long     Dim i As Long     Dim ChsStr As String     Dim ChtStr As String     ChsStr = GetStr(True)     ChtStr = GetStr(False)     For i = 1 To Len(ChsStr)         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))     Next     GetStrList = StrList End Function Function GetStr(isChs As Boolean) As String     Dim strFile As String     Dim strPath As String     Dim strText As String     strFile = VBE.ActiveVBProject.FileName     strPath = Left(strFile, InStrRev(strFile, ""))     If isChs Then         strFile = "chsstr.dat"     Else         strFile = "chtstr.dat"     End If         Open strPath & strFile For Input As #1     Do Until EOF(1)         Line Input #1, strText         GetStr = GetStr & strText     Loop     Close #1 End Function

userzhl

老大，试了不行呀。

 

mccad

8行和9行转成：
    Debug.Print "未转换简体字符：" & Str
    Debug.Print "已转换繁体字符：" & tmpStr

mccad

给一个双向转换的程序：大家可以试试，把它改造成适用于所有文本内容的转换程序。

2. Sub Main()
3.     Dim Str As String
4.     Dim tmpStr As String
5.     Str = "明经通道--AutoCAD机械设计园区AutoLisp,Inventor,VBA"
6.     tmpStr = ChtToChs(Str)
7.     Debug.Print "未转换简体字符：" & Str
8.     Debug.Print "已转换繁体字符：" & tmpStr
9.     'ThisDrawing.ModelSpace(0).TextString = tmpStr
10.     'ThisDrawing.ModelSpace(1).TextString = Str
11.     Str = tmpStr
12.     tmpStr = ChsToCht(Str)
13.     Debug.Print "已转回简体字符：" & tmpStr
14. End Sub
15. Function ChtToChs(Str As String) As String
16.     Dim i As Long
17.     Dim tmpStr As String
18.     Dim s  As String
19.     Dim StrList As Variant
20.     StrList = GetChtStrList
21.     For i = 1 To Len(Str)
22.         s = Mid(Str, i, 1)
23.         If Asc(s) <= -2050 Then
24.             s = Chr(StrList(Asc(s) + 24159))
25.         End If
26.         tmpStr = tmpStr & s
27.     Next
28.     ChtToChs = tmpStr
29. End Function
30. Function ChsToCht(Str As String) As String
31.     Dim i As Long
32.     Dim tmpStr As String
33.     Dim s  As String
34.     Dim StrList As Variant
35.     StrList = GetChsStrList
36.     On Error Resume Next
37.     For i = 1 To Len(Str)
38.         s = Mid(Str, i, 1)
39.         If Asc(s) <= 0 Then
40.             s = Chr(StrList(Asc(s) + 24313))
41.         End If
42.         If Err Then Debug.Print Asc(s): Err.Clear
43.         tmpStr = tmpStr & s
44.     Next
45.     ChsToCht = tmpStr
46. End Function
47. Function GetChtStrList() As Variant
48.     Dim StrList(22109) As Long
49.     Dim i As Long
50.     Dim ChsStr As String
51.     Dim ChtStr As String
52.     ChsStr = GetStr(True)
53.     ChtStr = GetStr(False)
54.     On Error Resume Next
55.     For i = 1 To Len(ChsStr)
56.         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
57.     Next
58.     GetChtStrList = StrList
59. End Function
60. Function GetChsStrList() As Variant
61.     Dim StrList(24312) As Long
62.     Dim i As Long
63.     Dim ChsStr As String
64.     Dim ChtStr As String
65.     Dim iStr As Long
66.     ChsStr = GetStr(True)
67.     ChtStr = GetStr(False)
68.     On Error Resume Next
69.     For i = 1 To Len(ChtStr)
70.         iStr = Asc(Mid(ChtStr, i, 1))
71.         If iStr <> 32 And iStr <> 9 Then StrList(iStr + 24256 + 57) = Asc(Mid(ChsStr, i, 1))
72.     Next
73.     GetChsStrList = StrList
74. End Function
75. Function GetStr(isChs As Boolean) As String
76.     Dim strFile As String
77.     Dim strPath As String
78.     Dim strText As String
79.     strFile = VBE.ActiveVBProject.FileName
80.     strPath = Left(strFile, InStrRev(strFile, ""))
81.     If isChs Then
82.         strFile = "chsstr.dat"
83.     Else
84.         strFile = "chtstr.dat"
85.     End If
86.         Open strPath & strFile For Input As #1
87.     Do Until EOF(1)
88.         Line Input #1, strText
89.         GetStr = GetStr & strText
90.     Loop
91.     Close #1
92. End Function

Sub Main()     Dim Str As String     Dim tmpStr As String     Str = "明经通道--AutoCAD机械设计园区AutoLisp,Inventor,VBA"     tmpStr = ChtToChs(Str)     Debug.Print "未转换简体字符：" & Str     Debug.Print "已转换繁体字符：" & tmpStr     'ThisDrawing.ModelSpace(0).TextString = tmpStr     'ThisDrawing.ModelSpace(1).TextString = Str     Str = tmpStr     tmpStr = ChsToCht(Str)     Debug.Print "已转回简体字符：" & tmpStr End Sub Function ChtToChs(Str As String) As String     Dim i As Long     Dim tmpStr As String     Dim s  As String     Dim StrList As Variant     StrList = GetChtStrList     For i = 1 To Len(Str)         s = Mid(Str, i, 1)         If Asc(s) <= -2050 Then             s = Chr(StrList(Asc(s) + 24159))         End If         tmpStr = tmpStr & s     Next     ChtToChs = tmpStr End Function Function ChsToCht(Str As String) As String     Dim i As Long     Dim tmpStr As String     Dim s  As String     Dim StrList As Variant     StrList = GetChsStrList     On Error Resume Next     For i = 1 To Len(Str)         s = Mid(Str, i, 1)         If Asc(s) <= 0 Then             s = Chr(StrList(Asc(s) + 24313))         End If         If Err Then Debug.Print Asc(s): Err.Clear         tmpStr = tmpStr & s     Next     ChsToCht = tmpStr End Function Function GetChtStrList() As Variant     Dim StrList(22109) As Long     Dim i As Long     Dim ChsStr As String     Dim ChtStr As String     ChsStr = GetStr(True)     ChtStr = GetStr(False)     On Error Resume Next     For i = 1 To Len(ChsStr)         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))     Next     GetChtStrList = StrList End Function Function GetChsStrList() As Variant     Dim StrList(24312) As Long     Dim i As Long     Dim ChsStr As String     Dim ChtStr As String     Dim iStr As Long     ChsStr = GetStr(True)     ChtStr = GetStr(False)     On Error Resume Next     For i = 1 To Len(ChtStr)         iStr = Asc(Mid(ChtStr, i, 1))         If iStr <> 32 And iStr <> 9 Then StrList(iStr + 24256 + 57) = Asc(Mid(ChsStr, i, 1))     Next     GetChsStrList = StrList End Function Function GetStr(isChs As Boolean) As String     Dim strFile As String     Dim strPath As String     Dim strText As String     strFile = VBE.ActiveVBProject.FileName     strPath = Left(strFile, InStrRev(strFile, ""))     If isChs Then         strFile = "chsstr.dat"     Else         strFile = "chtstr.dat"     End If         Open strPath & strFile For Input As #1     Do Until EOF(1)         Line Input #1, strText         GetStr = GetStr & strText     Loop     Close #1 End Function

vken7az2p

版主有各疑问
就是我用的是繁体系统
我在测试时

使用 GSEB 字体
将简体字写入CAD中,则内容居然变成了奇怪的代码

繁体显示: 植物种植设计统计表 ;内容: 植物种植设计统计表
简体显示: 植物种植设计统计表 ;内容: 植物种植\U+8BBE\U+8BA1\U+7EDF\U+8BA1表

繁体显示: 乔木 ;内容: 乔木
简体显示: 乔木 ;内容: \M+5C7C7\M+5C4BE

繁体显示: 环境绕射 ;内容: 环境绕射
简体显示: 环境绕射 ;内容: \M+5BBB7\M+5BEB3\M+5C8C6\M+5C9E4

请问这样该怎样处理文字取得问题呢?
希望各位高手可以解答一下
谢谢!