Questions similar to this appear on the Bentley Discussion Groups. These problems appeared in the MicroStation Programming Forum.

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
• Find a Font in the active DGN file
• Determine if a TextStyle exists in the active DGN file or in a DGNLib

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" ' See note below
    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

Saving Text Style Changes

After changing a TextStyle using VBA you probably want to save your changes. Unfortunately DesignFile.TextStyles provides no Save method.

In this example we work around the lack of a Save method by queuing a MicroStation key-in command TEXTSTYLE SAVEALL. However, that apparently is not a reliable work-around: some people have reported that it does nothing.

---

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 a thousand 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 String) 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

---

Find a Font

How do I find a Font programmatically so I can apply it to a TextElement?

A You can use VBA method ActiveDesignFile.Fonts.Find. Here's an example …

' ---------------------------------------------------------------------
'   FontAvailable
'   Test whether a named font is available in the active design file
'   Returns:    True if font can be used
' ---------------------------------------------------------------------
Public Function FontAvailable(ByVal name As String) As Boolean
    FontAvailable = False
    Dim msg                                 As String
    Dim oFont                               As Font
    Set oFont = ActiveDesignFile.Fonts.Find(msdFontTypeUnknown, name, Nothing)
    If oFont Is Nothing Then
        msg = "Found font " & Quote(name) & " is not available"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, False
    Else
        Dim fontType                        As String
        Select Case oFont.Type
        Case msdFontTypeMicroStation
            fontType = "MicroStation resource"
        Case msdFontTypeSHX
            fontType = "AutoCAD SHX"
        Case msdFontTypeWindowsTrueType
            fontType = "TrueType"
        End Select
        msg = "Found " & fontType & " font " & """" & name) & """"
        ShowMessage msg, msg, msdMessageCenterPriorityInfo, False
        FontAvailable = True
    End If
End Function

Note: the VBA method used above finds a Text Style wherever it is defined — in the active DGN file or an attached DGNLib. Where the Text Style definition exists may not be important to you if you just want to find it and apply it to a text element. However, if you need to know whether a Text Style definition already exists in the active design file, read the section below.

---

Where is a Text Style defined?

A Text Style may be defined in the active design file, or — if it has not yet been used — in an attached DGNLib. How can I tell where a Text Style definition is stored?

A This question is tricky to answer, because there is no direct solution using MicroStation VBA. Instead, we rely on an MDL function that provides more options than the built-in VBA methods. First, place this MDL function declaration at the top of your VBA module, before any procedure definitions …

' ---------------------------------------------------------------------
'   MDL function declarations
' ---------------------------------------------------------------------
Declare Function mdlTextStyle_getByName Lib "stdmdlbltin.dll" ( _
    ByRef pStyle As Long, _
    ByRef pTextStyleId As Long, _
    ByVal pStyleName As Long, _
    ByVal modelRef As Long, _
    ByVal SearchLibrary As Long) As Long
Private Const SUCCESS                       As Long = 0

Here's a VBA wrapper around that MDL function …

' ---------------------------------------------------------------------
'   TextStyleExists
'   Wraps MDL function that searches for a Text Style in DgnLibs
'   as well as the active DGN file
'   Returns: True if style is found
' ---------------------------------------------------------------------
Public Function TextStyleExists(ByVal name As String, ByVal searchLibs As Boolean) As Boolean
    Dim styleAddress                        As Long
    Dim styleIdAddress                      As Long
    styleIdAddress = -1
    TextStyleExists = (SUCCESS = mdlTextStyle_getByName( _
    			styleAddress, styleIdAddress, StrPtr(name), _
    			ActiveModelReference.MdlModelRefP, searchLibs))
    Debug.Print "style ID=" & CStr(styleIdAddress)
End Function

The searchLibs argument instructs the MDL function to search in only the active design file, or in the active design file and attached DGNLibs.

With that understanding, we can write methods that figure out where a Text Style is defined. First, is the Text Style defined only in the DGN file …

' ---------------------------------------------------------------------
'   TextStyleExistsInDgnFile
'   Test whether a named Text Style exists in the active design file
'   Returns:    True if found
' ---------------------------------------------------------------------
Public Function TextStyleExistsInDgnFile(ByVal name As String) As Boolean
    TextStyleExistsInDgnFile = TextStyleExists(name, False)
End Function

Second, is the Text Style defined either in the DGN file or in a DGNLib …

' ---------------------------------------------------------------------
'   TextStyleExistsInLibrary
'   Test whether a named Text Style exists in an attached DGNLib or
'   in the active design file
'   Returns:    True if found
' ---------------------------------------------------------------------
Public Function TextStyleExistsInLibrary(ByVal name As String) As Boolean
    TextStyleExistsInLibrary = TextStyleExists(name, True)
End Function

Finally, is the Text Style defined only in a DGNLib …

' ---------------------------------------------------------------------
'   TextStyleExistsOnlyInLibrary
'   Test whether a named Text Style exists only in an attached DGNLib
'   and not in the active design file
'   Returns:    True if found in DGNLib but not in active DGN file
' ---------------------------------------------------------------------
Public Function TextStyleExistsOnlyInLibrary(ByVal name As String) As Boolean
	Const Anywhere As Boolean = True
	Const InDgnFileOnly As Boolean = False
    TextStyleExistsOnlyInLibrary = _
    		TextStyleExists(name, Anywhere) _
    		And Not _
    		TextStyleExists(name, InDgnFileOnly)
End Function