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

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Revit area plans adding new types and references (Gross and rentable)