Đến nội dung


Hình ảnh
5 stars - based on 24598 reviews
- - - - -

Hỏi Về Cách Remove Formatting Code Trong Chuỗi Mtext (Vba)


  • Please log in to reply
5 replies to this topic

#1 Vạn Vô Thường

Vạn Vô Thường

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 June 2017 - 12:58 PM

chào các anh,

 

em mới tập tành viết vba cho autocad và giờ đang gặp vấn đề hóc búa ko sử lý được, mong các anh chỉ giáo.

 

hiện tại em muốn lấy nội dung của một Mtext vào biến a, nhưng khi trong Mtext lại có những dạng formatting code kiểu như vầy

 

 "{\\C4;Thêm \\fArial|b0|i0|c0|p34;2 cai \\fTimes New Roman|b0|i0|c0|p18;lỗ \\Pthoát hơi}" ,

 

 nó không hoàn toàn chỉ là chữ mình thấy hiển thị trong cad, vậy giờ làm sao để có thể xóa được tất cả các formatting code trong chuỗi này đi cách nhanh nhất, chứ nếu phải viết nguyên một hàm duyệt chuỗi này và phát hiện những formatting code này để xóa đi thì lâu quá.

 

Thanks and Best Regard!


  • 0

#2 dinhvantrang

dinhvantrang

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 05 June 2017 - 01:44 PM

.Hóng!


  • 0

Thanks and Best Regards

Skype : dinhvantrang73

 

Series video hướng dẫn lập trình VBA cho Autocad & Excel

https://www.youtube....m54mGak6O9YSmfT


#3 quansla

quansla

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 662 Bài viết
Điểm đánh giá: 231 (khá)

Đã gửi 05 June 2017 - 01:53 PM

Mình không biết về VBA nhưng nếu remove định dạng TEXT thì có thể tham khảo CODE của LISP có được không (xem nguồn từ LEE nhé)
http://www.lee-mac.c...rmatstring.html


  • 1

#4 Vạn Vô Thường

Vạn Vô Thường

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 07 June 2017 - 11:22 AM

Mình không biết về VBA nhưng nếu remove định dạng TEXT thì có thể tham khảo CODE của LISP có được không (xem nguồn từ LEE nhé)
http://www.lee-mac.c...rmatstring.html

cảm ơn bác quansla đã gợi ý, có điều em ko em ko biết về lisp, nên đọc vào cũng mù tịt,đang viết hàm tìm kiếm và replace, túng thiếu làm liều vậy, nội dung mtext cũng ko quan trọng lắm :)


  • 0

#5 vietanh2108

vietanh2108

    biết vẽ line

  • Members
  • PipPip
  • 20 Bài viết
Điểm đánh giá: 6 (bình thường)

Đã gửi 07 July 2017 - 08:48 AM

Bạn tham khảo thử! :)

Function UnformatMtext(S As String) As String

Dim P1 As Integer
Dim P2 As Integer, P3 As Integer
Dim intStart As Integer
Dim strCom As String
Dim strReplace As String

Debug.Print S

Select Case Left(S, 4)
Case "\A0;", "\A1;", "\A2;"
S = Mid(S, P1 + 5)
End Select
intStart = 1
Do
P1 = InStr(S, "%%")
If P1 = 0 Then
Exit Do
Else
Select Case Mid(S, P1 + 2, 1)
Case "P"
S = Replace(S, "%%P", "+or-")
Case "D"
S = Replace(S, "%%D", " deg")
End Select
End If
Loop

Do
P1 = InStr(intStart, S, "\", vbTextCompare)
If P1 = 0 Then Exit Do
strCom = Mid(S, P1, 2)
Select Case strCom
Case "\p"
P2 = InStr(1, S, ";")
S = Mid(S, P2 + 1)
Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, strCom, vbTextCompare)
If P3 = 0 Then
S = Left(S, P1 - 1) & Mid(S, P2 + 1)
End If
Do While P3 > 0
P2 = InStr(P3, S, ";", vbTextCompare)
S = Left(S, P3 - 1) & Mid(S, P2 + 1)
'Debug.Print s, strCom
P3 = InStr(1, S, strCom, vbTextCompare)
Loop
's = Left(s, P3 - 1) & mid(s, P3 + 1)
Case "\L", "\O"
Dim strLittle As String
strLittle = LCase(strCom)
P2 = InStr(P1 + 2, S, strLittle, vbTextCompare)
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P2 - (P1 + 2)) & Mid(S, P2 + 2)
Case "\S"
P2 = InStr(P1 + 2, S, ";", vbTextCompare)
P3 = InStr(P1 + 2, S, "/", vbTextCompare)
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "#", vbTextCompare)
End If
If P3 = 0 Or P3 > P2 Then
P3 = InStr(P1 + 2, S, "^", vbTextCompare)
End If
S = Left(S, P1 - 1) & Mid(S, P1 + 2, P3 - (P1 + 2)) _
& "/" & Mid(S, P3 + 1, (P2) - (P3 + 1)) & Mid(S, P2 + 1)

Case "\U"
strLittle = Mid(S, P1 + 3, 4)
Debug.Print strLittle
Select Case strLittle
Case "2248"
strReplace = "ALMOST EQUAL"
Case "2220"
strReplace = "ANGLE"
Case "2104"
strReplace = "CENTER LINE"
Case "0394"
strReplace = "DELTA"
Case "0278"
strReplace = "ELECTRIC PHASE"
Case "E101"
strReplace = "FLOW LINE"
Case "2261"
strReplace = "IDENTITY"
Case "E200"
strReplace = "INITIAL LENGTH"
Case "E102"
strReplace = "MONUMENT LINE"
Case "2260"
strReplace = "NOT EQUAL"
Case "2126"
strReplace = "OHM"
Case "03A9"
strReplace = "OMEGA"
Case "214A"
strReplace = "PROPERTY LINE"
Case "2082"
strReplace = "SUBSCRIPT2"
Case "00B2"
strReplace = "SQUARED"
Case "00B3"
strReplace = "CUBED"

End Select
S = Replace(S, "\U+" & strLittle, strReplace)

Case "\~"
S = Replace(S, "\~", " ")

Case "\\"
intStart = P1 + 2
S = Replace(S, "\\", "\")
GoTo Selectagain

Case "\P"
intStart = P1 + 1
GoTo Selectagain
Case Else
Exit Do
End Select
Selectagain:
Loop

Do
P1 = InStr(1, S, "\P", vbTextCompare)
If P1 = 0 Then
Exit Do
Else
S = Left(S, P1 - 1) & vbCrLf & Mid(S, P1 + 2)
End If
Loop
For intStart = 0 To 1
If intStart = 0 Then
strCom = "}"
Else
strCom = "{"
End If
P2 = InStr(1, S, strCom)

Do While P2 > 0
S = Left(S, P2 - 1) & Mid(S, P2 + 1)
P2 = InStr(1, S, strCom)
Loop
Next intStart


UnformatMtext = S

End Function

Sub Testmt()
Dim Mt As AcadMText, V As Variant
ThisDrawing.Utility.GetEntity Mt, V, "Pick an Mtext:"
Debug.Print Mt.TextString
Mt.TextString = UnformatMtext(Mt.TextString)
Debug.Print Mt.TextString
End Sub

  • 1

#6 dinhvantrang

dinhvantrang

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 July 2017 - 09:56 AM

Hàm làm việc tốt bác ợ. thank for share


  • 0

Thanks and Best Regards

Skype : dinhvantrang73

 

Series video hướng dẫn lập trình VBA cho Autocad & Excel

https://www.youtube....m54mGak6O9YSmfT