社区 › VBA/VB/ActiveX/API 编程技术 › [求助]如何转换将图面上繁体字或简体字互转呢?

vken7az2p 发表于 2008-9-8 06:50:00

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

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

mccad 发表于 2008-9-8 21:18:00

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

vken7az2p 发表于 2008-9-10 22:48:00

<p>再请问一下<br/>那该怎样将 取得文字内容的<br/>16进位 Unicode 转换成为<br/>ASCII 十六进位<br/>或<br/>ASCII 十进位<br/>呢?</p><p>烦请各位高手帮忙解答一下<br/>谢谢!<br/></p>

vken7az2p 发表于 2008-9-23 06:52:00

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

<p>该怎样建立字码互换表呢?</p><p>烦请各位高手帮忙解答一下<br/>谢谢!<br/></p>

mccad 发表于 2008-9-23 22:19:00

这是三年前写的一个简单的程序，附件中有对照字符表，应该是做为简体转繁体或繁体转简体用。
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 sAs 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 jAs Long
    Dim tmpStr As String
    Dim sAs 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 发表于 2008-10-20 13:00:00

<p>老大，试了不行呀。</p><p>&nbsp;</p>

mccad 发表于 2008-10-20 18:29:00

8行和9行转成：<br/>&nbsp;&nbsp;&nbsp; Debug.Print "未转换简体字符：" &amp; Str<br/>&nbsp;&nbsp;&nbsp; Debug.Print "已转换繁体字符：" &amp; tmpStr<br/>

mccad 发表于 2008-10-20 22:17:00

给一个双向转换的程序：大家可以试试，把它改造成适用于所有文本内容的转换程序。
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 sAs 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 sAs 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 发表于 2008-10-23 07:26:00

本帖最后由 作者 于 2008-10-23 7:26:39 编辑 <br /><br /> <p>版主有各疑问<br/>就是我用的是繁体系统<br/>我在测试时</p><p>使用 GSEB 字体<br/>将简体字写入CAD中,则内容居然变成了奇怪的代码</p><p>繁体显示: 植物种植设计统计表 ;内容: 植物种植设计统计表<br/>简体显示: 植物种植设计统计表 ;内容: 植物种植\U+8BBE\U+8BA1\U+7EDF\U+8BA1表</p><p>繁体显示: 乔木 ;内容: 乔木<br/>简体显示: 乔木 ;内容: \M+5C7C7\M+5C4BE</p><p>繁体显示: 环境绕射 ;内容: 环境绕射<br/>简体显示: 环境绕射 ;内容: \M+5BBB7\M+5BEB3\M+5C8C6\M+5C9E4</p><p>请问这样该怎样处理文字取得问题呢?<br/>希望各位高手可以解答一下<br/>谢谢!</p>

查看完整版本: [求助]如何转换将图面上繁体字或简体字互转呢?