Ad

Thursday, September 17, 2009

Mtext – Remove Color Overrides

Sometimes people do strange things like adding color overrides to mtext. This usually isn’t a problem when using an STB to plot out, but it can be troublesome when using CTB to plot. It becomes especially hard if the color in the mtext is the wrong color and going in to each mtext to remove the color overrides can take a long time. Now this hasn’t happened to me, but the problem peaked my interest on how to create a VBA Macro to remove the color overrides.

The first thing we have to understand is how AutoCAD stores the mtext overrides. Looking in the properties window we can see that color overrides are handled by using \C4; to indicate the color and { } to determine the text the override applys to.

image

Now that we now how AutoCAD stores the information we can remove the overrides. To do this the we need to take the TextString of the mtext object and parse it, remove the \C4; items from the text and then put the TextString back together and have the string be the new mtext. The code I came up with is below:

Option Explicit

Sub mTextChange()

Dim oAcadObj As AcadObject
Dim entbasepnt As Variant
Dim oMtxt As AcadMText

ThisDrawing.Utility.GetEntity oAcadObj, entbasepnt, "Pick mText: "

Set oMtxt = oAcadObj

ThisDrawing.Utility.Prompt vbCrLf & oMtxt.TextString

Dim sNewStr As String
Dim i As Integer
Dim lPos As Long
Dim lPos2 As Long
Dim bOverideColor As Boolean

sNewStr = oMtxt.TextString

bOverideColor = True
Do Until bOverideColor = False
lPos = InStr(1, sNewStr, "\C", 1)
If lPos = 0 Then
bOverideColor = False
Else
lPos2 = InStr(lPos, sNewStr, ";", 1)
' MsgBox lPos & " " & lPos2 & " " & sNewStr

Dim sFirst As String
Dim sSecond As String

sFirst = Left(sNewStr, lPos - 1)
sSecond = Right(sNewStr, Len(sNewStr) - lPos2)

sNewStr = sFirst & sSecond

' MsgBox sNewStr


End If
Loop

oMtxt.TextString = sNewStr

End Sub



InStr(postion, string, character, type of search) looks to see if the character is contained in the string starting at the position indicated. The type of search lets VBA know what type of character it’s looking for.



Left( string, position) collects all of the information in the string to the left of the position.



Right( string, position) collects all of the information in the string to the right of the position.



The code loops around until all of the \C characters have been removed. The final output TextString is below:



image



As you notice I haven’t removed the { }, I did this mainly to keep the code small. Other overrides also use the { } and I didn’t want to put additional code in that would make it difficult. Don’t worry though, the next time you go in and edit the text AutoCAD will remove them for you.



I haven’t tried the code out in all situations. I’m a little unsure what would happen if you did want \C4; included in the mtext. I think you’d want to check to see if there was an additional \ character before it and make sure to skip it.

image





The code in an actual VBA project file may be found on this page: style.civil3dreminders.com/programming

2 comments:

R.E.A.Apsis0215 said...

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

For Each ObjBlock In ThisDrawing.Blocks
If InStr(1, LCase(ObjBlock.Name), "seal") < 1 Then
For Each ObjAcad In ObjBlock
If InStr(1, LCase(ObjAcad.ObjectName), "mtext") > 0 Then
Set ObjTxt = ObjAcad
x = Split(ObjTxt.TextString, ";")
'if instr(1,"\fworking;", objtxt.
ObjTxt.TextString = x(UBound(x))
'Stop
End If
Next ObjAcad
End If
Next ObjBlock
End Sub

R.E.A.Apsis0215 said...

Thnx for the push-

A simplified version to strip ALL formatting:
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

For Each ObjBlock In ThisDrawing.Blocks
If InStr(1, LCase(ObjBlock.Name), "seal") < 1 Then
For Each ObjAcad In ObjBlock
If InStr(1, LCase(ObjAcad.ObjectName), "mtext") > 0 Then
Set ObjTxt = ObjAcad
x = Split(ObjTxt.TextString, ";")
'if instr(1,"\fworking;", objtxt.
ObjTxt.TextString = x(UBound(x))
'Stop
End If
Next ObjAcad
End If
Next ObjBlock
End Sub

LinkWithin

Blog Widget by LinkWithin

Ad