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.
TextElement
by its levelTextElement
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
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 …
TextStyle
variable to your TextElement's TextStyle
TextStyle
that you want to change
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
How do I find a Text Style 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.
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 PtrSafe 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