Text Element Analysis & Manipulation VBA

Q How do I extract the boundary of a TextElement  ? How do I extract the boundary when the TextElement  is rotated?

A A TextElement 's Boundary is a UDT with Low and High components, each a Point3d. If the TextElement  is not rotated, then these points can be used to construct a rectangle that represents the TextElement 's boundary.

When a TextElement  is rotated the Boundary.Low and Boundary.High points are modified so that they continue to provide the lowest and highest coordinates that bound the element. If you attempt to construct a rectangle from the boundary points of a rotated TextElement , you end up with something that appears to have little to do with the TextElement  you started with.

The solution is to unrotate the TextElement  before extracting its Boundary.Low and Boundary.High points. Then derive a rectangle from those points, and rotate the rectangle to the TextElement 's original rotation.

Q How do I increment the value of a TextElement  ? How do I change 500 TextElements automatically?

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 littly 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
' ---------------------------------------------------------------------
'   Double Quote If Space 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
' ---------------------------------------------------------------------
'   Double Quote 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
' ---------------------------------------------------------------------
'   Single Quote If Space 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
' ---------------------------------------------------------------------
'   Singe Quote 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

Q How do I set the active text settings and place text?

A First of all, consider using a text style rather than manipulating the active settings. Like paragraph styles in a text processor, such as Microsoft Word™, text styles allow you to define consistent settings. You can apply the same text style to a set of text elements, and then, if you need the text to look different, simply change the text style.

However, you want to know how to modify settings using VBA, rather than read my rants about super-duper features of MicroStation. The answer is very simple. So simple, in fact, that the code speaks for itself …

' ---------------------------------------------------------------------
'   Set Text Size
'   Set the current text height & width
' ---------------------------------------------------------------------
Sub SetTextSize(ByVal size As Double)
    If (0 < size) Then
        ActiveSettings.TextStyle.Height = size
        ActiveSettings.TextStyle.Width = size
    End If
End Sub
' ---------------------------------------------------------------------
'   Place custom text: text size 10, place 'X'
' ---------------------------------------------------------------------
Sub PlaceCustomText()
    SetTextSize 10

    Const command                           As String = "PLACE TEXT ICON;"
    Dim text                                As String
    '   Change this text to whatever you want
    text = "X"
    Debug.Print "This is the command sent to MicroStation: " & command & text
    CadInputQueue.SendCommand command & text, True
End Sub