Questions similar to this appear on the Bentley Discussion Groups. These problems appeared in the VBA discussion group.

MicroStation Text Styles let you apply consistent appearance to text elements. A Text Style defines almost every aspect of a text element's appearance. When you modify an existing Text Style, any text elements having that style are updated to reflect the modification.

• Create a Text Style
• Change the TextStyle of a TextElement by its level
• change the TextStyle of a TextElement

Q How do I create a new Text Style  ?

A One approach is to obtain an existing style, modify it, then add it to the design file's TextStyles collection. Here's an example …

' ---------------------------------------------------------------------
'   CreateTextStyle
'   Create a new text style by copying and modifying an existing text style
'   Returns:    True on success
' ---------------------------------------------------------------------
Function CreateTextStyle(ByVal textStyleName As String) As Boolean
    CreateTextStyle = False
    On Error GoTo err_CreateTextStyle

    Dim oTextStyle                          As TextStyle
    Dim oNewStyle                           As TextStyle
    '   Get an existing style
    Set oTextStyle = ActiveSettings.TextStyle
    '   Modify it: in this example we're changing only the text style's font
    Dim oFont                               As Font
    Set oFont = ActiveDesignFile.Fonts.Find(msdFontTypeWindowsTrueType, "Verdana")
    Set oTextStyle.Font = oFont
    oTextStyle.Height = 3
    oTextStyle.Width = 2.8
    '   Create it
    Set oNewStyle = ActiveDesignFile.TextStyles.Add(oTextStyle, textStyleName)
    '   Save it
    CadInputQueue.SendCommand "TEXTSTYLE SAVEALL"
    CreateTextStyle = True
    Exit Function

err_CreateTextStyle:
    Select Case Err.number
    Case msdErrorNameNotUnique
        MsgBox "Text Style '" & textStyleName & "' already exists", vbOKOnly Or vbInformation, "Text Style Exists"
    Case Else
        ReportError "CreateTextStyle"
    End Select
End Function

' ---------------------------------------------------------------------
Sub ReportError(ByVal procname As String)
    MsgBox "Error no. " & CStr(Err.number) & ": " & Err.Description & vbNewLine & "Caused by " & Err.Source, vbOKOnly Or vbExclamation, "Error in " & procname
End Sub

---

Q How do I change the TextStyle of a TextElement ? How do I change the font of a TextElement ?

A Changing a TextElement's font and style can seem a little tricky. You can't simply do the obvious, such as …

Dim oText As TextElement
... assign oText from somewhere
oText.TextStyle.BackgroundFillColor = 111

The reason you can't do that has to do with the way in which VBA handles the members of classes that contain sub-classes. It's explained in a remote corner of the MicroStation VBA documentation. Rather than perform the above sort of direct manipulation, obvious though it may seem, you have take some indirect steps to achieve your goal …

• Assign a TextStyle variable to your TextElement's TextStyle
• Set the members of the TextStyle that you want to change
• Assign your TextElement's TextStyle to your TextStyle variable

A similar sequence of steps is needed to change a TextElement's font. A line of code is worth 1,000 words: here's an example procedure …

' ---------------------------------------------------------------------
'   SetTextStyle
'   Attempt to set a text element's style and font
'   Example call syntax:
'   If (SetTextStyle (oText, "250Leroy")) Then ... End If
'   Returns:    True on success
' ---------------------------------------------------------------------
Function SetTextStyle(ByRef oText As TextElement, ByVal fontName) As Boolean

    SetTextStyle = False
    On Error GoTo err_SetTextStyle

    Dim oFont                               As Font
    Set oFont = ActiveDesignFile.Fonts.Find(msdFontTypeWindowsTrueType, fontName, Nothing)
    If oFont Is Nothing Then
        Dim warning                         As String
        warning = "Font '" & fontName & "' not in active DGN file"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
    Else
        Debug.Print "Found font '" & oFont.Name & "' in active DGN file"

        Dim oStyle                          As TextStyle
        Set oStyle = oText.TextStyle
        Set oStyle.Font = oFont
        oStyle.BackgroundFillColor = 253
        oStyle.BorderColor = 253
        oStyle.BorderAndBackgroundVisible = True
        Set oText.TextStyle = oStyle
        oText.Redraw msdDrawingModeNormal
        oText.Rewrite
        SetTextStyle = True
    End If
    Exit Function

err_SetTextStyle:
    MsgBox Err.Description, vbOKOnly Or vbCritical, "Error in SetTextStyle"
End Function

---

Q How do I change the TextStyle of a TextElement by its level ?

A The question arose because the VBA macro recorder doesn't see the settings changed when you use the Text Style dialog. This example illustrates how to set the text style by queuing a command …

Option Explicit
' ---------------------------------------------------------------------
'   Change Text Style by Level
' ---------------------------------------------------------------------
'   Notice:
'   Example MicroStation VBA code supplied by LA Solutions Ltd.
'   You are free to use this code in your own work provided that
'	this notice is retained in  full.  Use at your own risk.
'   Visit our website
'   http://www.la-solutions.co.uk
'   End of notice
' ---------------------------------------------------------------------
'   ChangeTextStyleByLevelTest
'   Tests the ChangeTextStyleByLevel subroutine
' ---------------------------------------------------------------------
Sub ChangeTextStyleByLevelTest()

    Debug.Print "ChangeTextStyleByLevel Test"

    Dim strTextStyle                        As String, _
        strLevelName                        As String

    strTextStyle = "Arial Blue"     '   This is an example: change to your text style name
    strLevelName = "Words"          '   This is an example: change to your level name
    ChangeTextStyleByLevel strTextStyle, strLevelName

    strTextStyle = "Lucida Green"   '   This is an example: change to your text style name
    strLevelName = "More Words"     '   This is an example: change to your level name
    ChangeTextStyleByLevel strTextStyle, strLevelName

    CommandState.StartDefaultCommand
End Sub
' ---------------------------------------------------------------------
'   ChangeTextStyleByLevel
'   Change text elements on a specified level by applying a Text Style
' ---------------------------------------------------------------------
Sub ChangeTextStyleByLevel(ByVal strTextStyle As String, ByVal strLevelName As String)

    Debug.Print "ChangeTextStyleByLevel Text Style " & SingleQuote(strTextStyle) & " Level " & SingleQuote(strLevelName); ""

    Dim confirm                             As Point3d
    '   Arbitrary coordinates to confirm commands that require a datapoint
    confirm = Point3dFromXY(1, 1)

    '   Local reference to active text style
    Dim oTextStyle                          As TextStyle
    Set oTextStyle = ActiveSettings.TextStyle

    '   Send a keyin that selects all elements on the specified level
    CadInputQueue.SendKeyin "level element select " & DoubleQuoteIfSpace(strLevelName)
    '   Start the Change Text Attributes command
    CadInputQueue.SendCommand "DMSG ACTIVATETOOLBYPATH \Drawing\Text\Change Text Attributes"
    '   Change the active text style
    CadInputQueue.SendCommand "textstyle active " & strTextStyle
    Debug.Print "Active text style is " & oTextStyle.Name
    '   Apply the new style to selected text
    CadInputQueue.SendCommand "MODIFY TEXT"
    '   Confirm the current command
    CadInputQueue.SendDataPoint confirm, 1
    '   Send a reset to the current command
    CadInputQueue.SendReset
    '   Drop selection
    CadInputQueue.SendCommand "CHOOSE NONE"

End Sub
' ---------------------------------------------------------------------
'   DoubleQuoteIfSpace wraps a string in double-quote marks if the string contains a space
' ---------------------------------------------------------------------
Function DoubleQuoteIfSpace(ByVal s As String) As String
    If (HasSpace(s)) Then
        DoubleQuoteIfSpace = DoubleQuote(s)
    Else
        DoubleQuoteIfSpace = s
    End If
End Function
' ---------------------------------------------------------------------
'   DoubleQuote wraps a string in double-quote marks
' ---------------------------------------------------------------------
Function DoubleQuote(ByVal s As String) As String
    Const Quote                             As String = """"
    DoubleQuote = Quote & s & Quote
End Function
' ---------------------------------------------------------------------
'   SingleQuoteIfSpace wraps a string in double-quote marks if the string contains a space
' ---------------------------------------------------------------------
Function SingleQuoteIfSpace(ByVal s As String) As String
    If (HasSpace(s)) Then
        SingleQuoteIfSpace = SingleQuote(s)
    Else
        SingleQuoteIfSpace = s
    End If
End Function
' ---------------------------------------------------------------------
'   SingeQuote wraps a string in single-quote marks
' ---------------------------------------------------------------------
Function SingleQuote(ByVal s As String) As String
    Const Quote                             As String = "'"
    SingleQuote = Quote & s & Quote
End Function
' ---------------------------------------------------------------------
'   HasSpace returns True if string contains a space
' ---------------------------------------------------------------------
Function HasSpace(ByVal s As String) As Boolean
    HasSpace = False
    Const Space                             As String = " "
    If (0 < InStr(1, s, Space)) Then
        HasSpace = True
    End If
End Function