[Thảo luận]Code vb.net chuyển đổi font chữ sang unicode

[quyenpv 2]

KÍnh gửi các anh chị trên diễn đàn!

Hiện trên diễn đàn mình có mấy Tool chuyển đổi font chữ nhưng em chưa dùng được, có mạo muội xin code của anh gia_bach nhưng không được. Nhu cầu chuyển đổi font em vẫn còn do đó đang viết code vb.net nhưng không chuyển được, mong các anh chị hỗ trợ xây dựng hoàn chỉnh chia sẻ cho mọi người cùng dùng

Em cám ơn

Imports System.Collections.Generic
Imports System.Security.Cryptography
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Public Class ConvertFont
    Private Shared unichars As Char() = {
        "à"c, "á"c, "ả"c, "ã"c, "ạ"c,
        "ă"c, "ằ"c, "ắ"c, "ẳ"c, "ẵ"c, "ặ"c,
        "â"c, "ầ"c, "ấ"c, "ẩ"c, "ẫ"c, "ậ"c,
        "đ"c, "è"c, "é"c, "ẻ"c, "ẽ"c, "ẹ"c,
        "ê"c, "ề"c, "ế"c, "ể"c, "ễ"c, "ệ"c,
        "ì"c, "í"c, "ỉ"c, "ĩ"c, "ị"c,
        "ò"c, "ó"c, "ỏ"c, "õ"c, "ọ"c,
        "ô"c, "ồ"c, "ố"c, "ổ"c, "ỗ"c, "ộ"c,
        "ơ"c, "ờ"c, "ớ"c, "ở"c, "ỡ"c, "ợ"c,
        "ù"c, "ú"c, "ủ"c, "ũ"c, "ụ"c,
        "ư"c, "ừ"c, "ứ"c, "ử"c, "ữ"c, "ự"c,
        "ỳ"c, "ý"c, "ỷ"c, "ỹ"c, "ỵ"c,
        "Ă"c, "Â"c, "Đ"c, "Ê"c, "Ô"c, "Ơ"c, "Ư"c,
        "À"c, "Á"c, "Ả"c, "Ã"c, "Ạ"c,
        "Ằ"c, "Ắ"c, "Ẳ"c, "Ẵ"c, "Ặ"c,
        "Ầ"c, "Ấ"c, "Ẩ"c, "Ẫ"c, "Ậ"c,
        "È"c, "É"c, "Ẻ"c, "Ẽ"c, "Ẹ"c,
        "Ề"c, "Ế"c, "Ể"c, "Ễ"c, "Ệ"c,
        "Ì"c, "Í"c, "Ỉ"c, "Ĩ"c, "Ị"c,
        "Ò"c, "Ó"c, "Ỏ"c, "Õ"c, "Ọ"c,
        "Ồ"c, "Ố"c, "Ổ"c, "Ỗ"c, "Ộ"c,
        "Ờ"c, "Ớ"c, "Ở"c, "Ỡ"c, "Ợ"c,
        "Ù"c, "Ú"c, "Ủ"c, "Ũ"c, "Ụ"c,
        "Ừ"c, "Ứ"c, "Ử"c, "Ữ"c, "Ự"c,
        "Ỳ"c, "Ý"c, "Ỷ"c, "Ỹ"c, "Ỵ"c
    }

    Private Shared tcvnchars As Char() = {
        "µ"c, "¸"c, "¶"c, "·"c, "¹"c,
        "¨"c, "»"c, "¾"c, "¼"c, "½"c, "Æ"c,
        "©"c, "Ç"c, "Ê"c, "È"c, "É"c, "Ë"c,
        "®"c, "Ì"c, "Ð"c, "Î"c, "Ï"c, "Ñ"c,
        "ª"c, "Ò"c, "Õ"c, "Ó"c, "Ô"c, "Ö"c,
        "×"c, "Ý"c, "Ø"c, "Ü"c, "Þ"c,
        "ß"c, "ã"c, "á"c, "â"c, "ä"c,
        "«"c, "å"c, "è"c, "æ"c, "ç"c, "é"c,
        "¬"c, "ê"c, "í"c, "ë"c, "ì"c, "î"c,
        "ï"c, "ó"c, "ñ"c, "ò"c, "ô"c,
        "­"c, "õ"c, "ø"c, "ö"c, "÷"c, "ù"c,
        "ú"c, "ý"c, "û"c, "ü"c, "þ"c,
        "¡"c, "¢"c, "§"c, "£"c, "¤"c, "¥"c, "¦"c
    }

    Private Shared tcvncharssub As Char() = {
        "µ"c, "¸"c, "¶"c, "·"c, "¹"c,
        "»"c, "¾"c, "¼"c, "½"c, "Æ"c,
        "Ç"c, "Ê"c, "È"c, "É"c, "Ë"c,
        "Ì"c, "Ð"c, "Î"c, "Ï"c, "Ñ"c,
        "Ò"c, "Õ"c, "Ó"c, "Ô"c, "Ö"c,
        "×"c, "Ý"c, "Ø"c, "Ü"c, "Þ"c,
        "ß"c, "ã"c, "á"c, "â"c, "ä"c,
        "«"c, "å"c, "è"c, "æ"c, "ç"c, "é"c,
        "ê"c, "í"c, "ë"c, "ì"c, "î"c,
        "ó"c, "ñ"c, "ò"c, "ô"c,
        "­"c, "õ"c, "ø"c, "ö"c, "÷"c, "ù"c,
        "ý"c, "û"c, "ü"c, "þ"c
    }

    Private Shared vnichars As String() = {
        "aø", "aù", "aû", "aõ", "aï",
        "aê", "aè", "aé", "aú", "aü", "aë",
        "aâ", "aà", "aá", "aå", "aã", "aä",
        "ñ", "eø", "eù", "eû", "eõ", "eï",
        "eâ", "eà", "eá", "eå", "eã", "eä",
        "ì", "í", "æ", "ó", "ò",
        "oø", "où", "oû", "oõ", "oï",
        "oâ", "oà", "oá", "oå", "oã", "oä",
        "ô", "ôø", "ôù", "ôû", "ôõ", "ôï",
        "uø", "uù", "uû", "uõ", "uï",
        "ö", "öø", "öù", "öû", "öõ", "öï",
        "yø", "yù", "yû", "yõ", "î",
        "AÊ", "AÂ", "Ð", "EÂ", "OÂ", "Ô", "Ö",
        "AØ", "AÙ", "AÛ", "AÕ", "AÏ",
        "AÈ", "AÉ", "AÚ", "AÜ", "AË",
        "AÀ", "AÁ", "AÅ", "AÃ", "AÄ",
        "EØ", "EÙ", "EÛ", "EÕ", "EÏ",
        "EÀ", "EÁ", "EÅ", "EÃ", "EÄ",
        "Ì", "Í", "Æ", "Ó", "Ò",
        "OØ", "OÙ", "OÛ", "OÕ", "OÏ",
        "OÀ", "OÁ", "OÅ", "OÃ", "OÄ",
        "ÔØ", "ÔÙ", "ÔÛ", "ÔÕ", "ÔÏ",
        "UØ", "UÙ", "UÛ", "UÕ", "UÏ",
        "ÖØ", "ÖÙ", "ÖÛ", "ÖÕ", "ÖÏ",
        "YØ", "YÙ", "YÛ", "YÕ", "Î"
    }

    Private Shared vnicharssub As Char() = {"ñ"c, "ì"c, "í"c, "æ"c, "ó"c, "ò"c, "î"c, "Đ"c, "Ì"c, "Í"c, "Ó"c, "Ò"c, "Î"c}
    Private Shared vnicharssub2 As Char() = {"ô"c, "ö"c, "Ô"c, "Ö"c, "a"c, "A"c, "e"c, "E"c, "o"c, "O"c, "u"c, "U"c, "y"c, "Y"c}

    Private Shared dicUnichars As Dictionary(Of Char, Integer) = Nothing
    Private Shared dicTcvnchars As Dictionary(Of Char, Integer) = Nothing
    Private Shared dicTcvncharsSub As Dictionary(Of Char, Integer) = Nothing
    Private Shared dicVnichars As Dictionary(Of String, Integer) = Nothing
    Private Shared dicVnicharsSub As Dictionary(Of Char, Integer) = Nothing
    Private Shared dicVnicharsSub2 As Dictionary(Of Char, Integer) = Nothing

    Private Shared hashUnichars As HashSet(Of Char) = Nothing
    Private Shared hashTcvnchars As HashSet(Of Char) = Nothing
    Private Shared hashTcvncharsSub As HashSet(Of Char) = Nothing
    Private Shared hashVnichars As HashSet(Of String) = Nothing
    Private Shared hashVnicharsSub As HashSet(Of Char) = Nothing
    Private Shared hashVnicharsSub2 As HashSet(Of Char) = Nothing

    Private Shared lenUniChars As Integer = -1
    Private Shared lenTcvnChars As Integer = -1
    Private Shared lenVniChars As Integer = -1

    Private Sub MapUni()
        If dicUnichars Is Nothing Then
            dicUnichars = New Dictionary(Of Char, Integer)()
            For i As Integer = 0 To unichars.Length - 1
                dicUnichars.Add(unichars(i), i)
            Next
        End If

        If hashUnichars Is Nothing Then
            hashUnichars = New HashSet(Of Char)()
            For i As Integer = 0 To unichars.Length - 1
                hashUnichars.Add(unichars(i))
            Next
        End If
    End Sub

    Private Sub MapTcvn()
        If dicTcvnchars Is Nothing Then
            dicTcvnchars = New Dictionary(Of Char, Integer)()
            For i As Integer = 0 To tcvnchars.Length - 1
                dicTcvnchars.Add(tcvnchars(i), i)
            Next
        End If

        If dicTcvncharsSub Is Nothing Then
            dicTcvncharsSub = New Dictionary(Of Char, Integer)()
            For i As Integer = 0 To tcvncharssub.Length - 1
                dicTcvncharsSub.Add(tcvncharssub(i), i)
            Next
        End If

        If hashTcvnchars Is Nothing Then
            hashTcvnchars = New HashSet(Of Char)()
            For i As Integer = 0 To tcvnchars.Length - 1
                hashTcvnchars.Add(tcvnchars(i))
            Next
        End If

        If hashTcvncharsSub Is Nothing Then
            hashTcvncharsSub = New HashSet(Of Char)()
            For i As Integer = 0 To tcvncharssub.Length - 1
                hashTcvncharsSub.Add(tcvncharssub(i))
            Next
        End If
    End Sub

    Private Sub MapVni()
        If dicVnichars Is Nothing Then
            dicVnichars = New Dictionary(Of String, Integer)()
            For i As Integer = 0 To vnichars.Length - 1
                dicVnichars.Add(vnichars(i), i)
            Next
        End If

        If dicVnicharsSub Is Nothing Then
            dicVnicharsSub = New Dictionary(Of Char, Integer)()
            For i As Integer = 0 To vnicharssub.Length - 1
                dicVnicharsSub.Add(vnicharssub(i), i)
            Next
        End If

        If dicVnicharsSub2 Is Nothing Then
            dicVnicharsSub2 = New Dictionary(Of Char, Integer)()
            For i As Integer = 0 To vnicharssub2.Length - 1
                dicVnicharsSub2.Add(vnicharssub2(i), i)
            Next
        End If

        If hashVnichars Is Nothing Then
            hashVnichars = New HashSet(Of String)()
            For i As Integer = 0 To vnichars.Length - 1
                hashVnichars.Add(vnichars(i))
            Next
        End If

        If hashVnicharsSub Is Nothing Then
            hashVnicharsSub = New HashSet(Of Char)()
            For i As Integer = 0 To vnicharssub.Length - 1
                hashVnicharsSub.Add(vnicharssub(i))
            Next
        End If

        If hashVnicharsSub2 Is Nothing Then
            hashVnicharsSub2 = New HashSet(Of Char)()
            For i As Integer = 0 To vnicharssub2.Length - 1
                hashVnicharsSub2.Add(vnicharssub2(i))
            Next
        End If
    End Sub

    Private Function ToTcvn(ByVal c As Char) As Char
        If dicUnichars Is Nothing Then
            MapUni()
        End If

        Dim index As Integer = 0
        If dicUnichars.TryGetValue(c, index) Then
            If index >= 0 AndAlso index < tcvnchars.Length Then
                Return tcvnchars(index)
            End If
        End If

        Return c
    End Function


    Private Function ToVni(ByVal str As String) As String
        If dicVnichars Is Nothing Then
            MapVni()
        End If

        Dim result As String = ""
        Dim i As Integer = 0
        While i < str.Length
            Dim index As Integer = 0
            If i < str.Length - 1 Then
                If dicVnichars.TryGetValue(str.Substring(i, 2), index) Then
                    result += vnicharssub2(index)
                    i += 1
                Else
                    result += str(i)
                End If
            Else
                result += str(i)
            End If
            i += 1
        End While
        Return result
    End Function

    Private Function ToVni(ByVal c As Char) As Char
        If dicUnichars Is Nothing Then
            MapUni()
        End If

        Dim index As Integer = 0
        If dicUnichars.TryGetValue(c, index) Then
            Return vnichars(index)(0)
        End If

        Return c
    End Function

    Private Function ToUnicode(ByVal str As String) As String
        If dicTcvnchars Is Nothing Then
            MapTcvn()
        End If

        Dim result As String = ""
        For i As Integer = 0 To str.Length - 1
            Dim c As Char = str(i)
            Dim index As Integer = 0

            If hashTcvnchars.Contains(c) Then
                If i < str.Length - 1 Then
                    If dicTcvncharsSub.TryGetValue(str(i + 1), index) Then
                        result += unichars(index)
                        i += 1
                    Else
                        result += unichars(dicTcvnchars(c))
                    End If
                Else
                    result += unichars(dicTcvnchars(c))
                End If
            Else
                result += c
            End If
        Next
        Return result
    End Function

    Private Function ToUnicode(ByVal c As Char) As Char
        If dicTcvnchars Is Nothing Then
            MapTcvn()
        End If

        Dim index As Integer = 0
        If hashTcvnchars.Contains(c) Then
            If dicTcvncharsSub.TryGetValue(c, index) Then
                Return unichars(index)
            Else
                Return unichars(dicTcvnchars(c))
            End If
        End If

        Return c
    End Function

    Public Function Convert(ByVal str As String) As String
        Dim result As String = ""
        For i As Integer = 0 To str.Length - 1
            Dim c As Char = str(i)

            If hashUnichars.Contains(c) Then
                result += ToTcvn(c)
            ElseIf i < str.Length - 1 AndAlso hashVnichars.Contains(str.Substring(i, 2)) Then
                result += ToUnicode(str.Substring(i, 2))
                i += 1
            ElseIf hashVnicharsSub.Contains(c) Then
                result += ToVni(c)
            ElseIf hashVnicharsSub2.Contains(c) Then
                result += ToVni(str.Substring(i))
                Exit For
            Else
                result += c
            End If
        Next
        Return result
    End Function
    Public Function CheckForTcvnChars(ByVal str As String) As Boolean
        If dicTcvnchars Is Nothing Then
            MapTcvn()
        End If

        For Each c As Char In str
            If hashTcvnchars.Contains(c) Then
                Return True
            End If
        Next

        Return False
    End Function

    Public Function CheckForVniChars(ByVal str As String) As Boolean
        If dicVnichars Is Nothing Then
            MapVni()
        End If

        For i As Integer = 0 To str.Length - 1
            If i < str.Length - 1 Then
                If hashVnichars.Contains(str.Substring(i, 2)) Then
                    Return True
                End If
            End If

            If hashVnicharsSub.Contains(str(i)) Then
                Return True
            End If

            If hashVnicharsSub2.Contains(str(i)) Then
                Return True
            End If
        Next

        Return False
    End Function
    Public Sub New()
        MapUni()
        MapTcvn()
        MapVni()
    End Sub

End Class
Public Class M_ConvertFont
    <CommandMethod("ConvertFont")>
    Public Sub ConvertFont()

        ' Kết nối đến ứng dụng AutoCAD
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Bắt đầu giao dịch để thực hiện thay đổi dữ liệu
        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Try
                ' Mở bảng Text và lấy tất cả các văn bản trong bản vẽ
                Dim textTable As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
                Dim modelspace As BlockTableRecord = tr.GetObject(textTable(BlockTableRecord.ModelSpace), OpenMode.ForRead)

                Dim converter As New ConvertFont() ' Khởi tạo đối tượng ConvertFont

                For Each objId As ObjectId In modelspace
                    Dim ent As Entity = tr.GetObject(objId, OpenMode.ForRead)

                    ' Kiểm tra xem đối tượng có phải là văn bản hay không
                    If TypeOf ent Is DBText Then
                        Dim text As DBText = DirectCast(ent, DBText)

                        ' Kiểm tra văn bản có chứa ký tự của font TCVN3 hay không
                        Dim hasTcvnChars As Boolean = converter.CheckForTcvnChars(text.TextString)

                        ' Kiểm tra văn bản có chứa ký tự của font VNI hay không
                        Dim hasVniChars As Boolean = converter.CheckForVniChars(text.TextString)

                        ' Nếu văn bản chứa ký tự của font TCVN3 hoặc VNI, thực hiện chuyển đổi sang Unicode
                        If hasTcvnChars Or hasVniChars Then
                            Dim newText As String = converter.Convert(text.TextString)
                            text.UpgradeOpen()
                            text.TextString = newText
                            text.DowngradeOpen()
                        End If
                    End If
                Next

                ' Lưu thay đổi và kết thúc giao dịch
                tr.Commit()
                ed.WriteMessage(vbLf & "Chuyển đổi hoàn thành.")
            Catch ex As Exception
                ed.WriteMessage(vbLf & "Đã xảy ra lỗi: " & ex.Message)
                tr.Abort()
            End Try
        End Using
    End Sub



End Class

 

[quyenpv 2]

Mình đã hoàn thành được 90% code và giao diện rồi, chạy test đã ok. Còn thêm một số chức năng phụ trợ như trong phần Change Case nữa (phần này không khó). Mượn tạm cách thiết kế giao diện của anh gia_bach

1. Cho phép Convert font cả bản vẽ

2. Cho chọn từng đối tượng Text cần chuyển đổi

3. Text thử nghiệm

Và đây là kết quả

[cuongtk2 342]

Đừng làm động tác convert cả bản vẽ bạn ơi, có thể sẽ convert từ Unicode sang Unicode đấy.

[quyenpv 2]

9 phút trước, cuongtk2 đã nói:

Đừng làm động tác convert cả bản vẽ bạn ơi, có thể sẽ convert từ Unicode sang Unicode đấy.

Dạ anh, cái đó em code có loại trừ trường hợp này rồi ạ

[cuongtk2 342]

Em thử trộn TCVN3 và Unicode trong Mtext xem convert ra cái gì? Nhìn bề ngoài khó phân biệt nó chứa 2 font

 

[quyenpv 2]

Vào lúc 28/7/2023 tại 17:33, cuongtk2 đã nói:

Em thử trộn TCVN3 và Unicode trong Mtext xem convert ra cái gì? Nhìn bề ngoài khó phân biệt nó chứa 2 font

 

Test và chỉnh code các kiểu vẫn không xử lý được một nội dung mà nhiều kiểu Font được anh, còn riêng biệt thì code xử lý tốt

[OngNguyenVanHan 1]

cho em góp ý tạm ạ, e nhìn giao diện nó hơn cổ cổ giống mấy cái phần mềm win xp ấy. anh đổi nền với fonts chữ (vd: time new romen) nhìn cho nó đẹp hoặc a xem win 11 nó dùng cái gì thì áp vào anh ạ

[tannguyen291 135]

Code .net sướng thật mình code bằng lisp viết ký tự có dấu đều phải dùng U+Hex, Ascii để thay thế.

Ví dụ như thế này ngồi nhìn mệt ẻ :)

 

Vào lúc 28/7/2023 tại 17:22, quyenpv đã nói:

Dạ anh, cái đó em code có loại trừ trường hợp này rồi ạ

Bạn có loại trừ được trường hợp text chỉ có các ký tự trong bảng ASCII 255 thì làm sao phân biệt được.

Ví dụ chữ "nông" "nên"

[7o7 79]

3 giờ trước, OngNguyenVanHan đã nói:

cho em góp ý tạm ạ, e nhìn giao diện nó hơn cổ cổ giống mấy cái phần mềm win xp ấy. anh đổi nền với fonts chữ (vd: time new romen) nhìn cho nó đẹp hoặc a xem win 11 nó dùng cái gì thì áp vào anh ạ

Giao diện free có xài là mừng húm rồi bạn.

[quyenpv 2]

Vào lúc 4/8/2023 tại 12:38, tannguyen291 đã nói:

Code .net sướng thật mình code bằng lisp viết ký tự có dấu đều phải dùng U+Hex, Ascii để thay thế.

Ví dụ như thế này ngồi nhìn mệt ẻ :)

 

Bạn có loại trừ được trường hợp text chỉ có các ký tự trong bảng ASCII 255 thì làm sao phân biệt được.

Ví dụ chữ "nông" "nên"

Mình không thấy bị lỗi như thế trong Code của mình, mình test thử và up lên Youtube đây

Test chuyển Font chữ trong Autocad viết bằng VB.Net

[tannguyen291 135]

18 giờ trước, quyenpv đã nói:

Mình không thấy bị lỗi như thế trong Code của mình, mình test thử và up lên Youtube đây

 Test chuyển Font chữ trong Autocad viết bằng VB.Net

Bạn thử viết nguyên chữ "nông" thôi. Rồi convert từ TCVN3 qua Unicode xem ntn

[quyenpv 2]

2 giờ trước, tannguyen291 đã nói:

Bạn thử viết nguyên chữ "nông" thôi. Rồi convert từ TCVN3 qua Unicode xem ntn

Đây bạn code mình không bị lỗi

Chuyển đổi Font theo yêu cầu của tannguyen291

[tannguyen291 135]

19 phút trước, quyenpv đã nói:

Đây bạn code mình không bị lỗi

 Chuyển đổi Font theo yêu cầu của tannguyen291

sao bạn không bấm thêm phát nữa xem máy có hiểu nhầm k :))

[quyenpv 2]

4 giờ trước, tannguyen291 đã nói:

sao bạn không bấm thêm phát nữa xem máy có hiểu nhầm k :))

Đây bạn nhé

Chuyển đổi Font theo yêu cầu của tannguyen291

[cuongtk2 342]

@quyenpv: Bạn nên làm 1 form cho lệnh thôi . Nếu cần mình sẽ gửi code tham khảo

[quyenpv 2]

4 giờ trước, cuongtk2 đã nói:

@quyenpv: Bạn nên làm 1 form cho lệnh thôi . Nếu cần mình sẽ gửi code tham khảo

 

Vâng cám ơn anh! Nếu được anh gửi giúp em tham khảo với ạ

Email em: quyenpv@gmail.com hoặc zalo số: 0363456868

Em cám ơn anh nhiều

[cuongtk2 342]

Anh viết ra 1 app đây nhé. Em xem áp dụng sao cho phù hợp .

ConvertFont.zip

[quyenpv 2]

Dạ em cám ơn anh nhiều, để em xem thao khảo ạ

Code anh quá hoành tráng, cái vụ tạo theme tuyệt vời quá anh

[quyenpv 2]

Form của em cũng chỉ có một Form do em đảo vị trí của Button khi chọn checkbox thôi. Code anh đáng học hỏi nhiều ạ