CVBA Code for stripping format codes from MTEXT to regular MTEXT
''https://forums.autodesk.com/t5/visual-basic-customization/mtext-format-codes/m-p/8725449#M102647
Attribute VB_Name = "ACAD_TEXT"
''AutoCAD VBA 2010
''Routine to strip formatting in ALL Autocad MTEXT (Translating Revit
''"text" to autocad drawings dumps as MTEXT with some odd formatting
''issues) try this:
Option Explicit
Sub Make_Mtext_StyleDependant()
Dim oAcadObj As AcadObject
Dim ObjBlock As AcadBlock
Dim ObjBlocks As AcadBlockReference
Dim ObjTxt As AcadMText
Dim ObjAcad As AcadObject
Dim x
Dim re As New RegExp
Set re = CreateObject("VBScript.RegExp")
For Each ObjBlock In ThisDrawing.Blocks
If InStr(1, LCase(ObjBlock.Name), "seal") < 1 Then ''don't mess with the seals!
For Each ObjAcad In ObjBlock
If InStr(1, LCase(ObjAcad.ObjectName), "mtext") > 0 Then
Set ObjTxt = ObjAcad
x = UnformatMtext(ObjTxt.TextString)
ObjTxt.TextString = x
End If
Next ObjAcad
End If
Next ObjBlock
End Sub
Function ReReplace(str As String, pat As String, repl As String) As String
Dim re As New RegExp
Dim Found As Boolean
Set re = CreateObject("VBScript.RegExp")
re.IgnoreCase = False
re.Pattern = pat
re.Global = True
Found = re.Test(str)
ReReplace = re.Replace(str, repl)
End Function
Function UnformatMtext(S As String) As String
''https://forums.autodesk.com/t5/visual-basic-customization/mtext-format-codes/td-p/356713
Dim P1 As Integer
Dim P2 As Integer, P3 As Integer
Dim intStart As Integer
Dim strCom As String
Dim strReplace As String
S = ReReplace(S, "\\A[012]\;", "")
S = ReReplace(S, "\%\%P", "+or-")
S = ReReplace(S, "\%\%D", "+or-")
S = ReReplace(S, "\\P", Chr(10))
S = ReReplace(S, "\\[ACfFQTWHp].*?\;", "")
S = ReReplace(S, "\\[LO].*\;", "")
S = ReReplace(S, "\\[S](.*?)\;", "$1")
S = ReReplace(S, "\\U2248", "ALMOST EQUAL")
S = ReReplace(S, "\\U2220", "ANGLE")
S = ReReplace(S, "\\U2104", "CENTER LINE")
S = ReReplace(S, "\\U0394", "DELTA")
S = ReReplace(S, "\\U0278", "ELECTRIC PHASE")
S = ReReplace(S, "\\UE101", "FLOW LINE")
S = ReReplace(S, "\\U2261", "IDENTITY")
S = ReReplace(S, "\\UE200", "INITIAL LENGTH")
S = ReReplace(S, "\\UE102", "MONUMENT LINE")
S = ReReplace(S, "\\U2260", "NOT EQUAL")
S = ReReplace(S, "\\U2126", "OHM")
S = ReReplace(S, "\\U03A9", "OMEGA")
S = ReReplace(S, "\\U214A", "PROPERTY LINE")
S = ReReplace(S, "\\U2082", "SUBSCRIPT2")
S = ReReplace(S, "\\U00B2", "SQUARED")
S = ReReplace(S, "\\U00B3", "CUBED")
S = Replace(S, "\\\~", " ")
S = Replace(S, "\\", "\")
UnformatMtext = S
End Function
Comments
Post a Comment