I have code made by Chuck Rheault that allows you to select individual Geopak labels to toggle background.
Would it be possible to convert this to add backgrounds to ALL the Geopak labels in a model so I do not have to select them all individually?
Geopak V8i (SS10) 08.11.09.918
Microstation (SS10) 08.11.09.919
TextBackground.mvba
Peter Violette said:Would it be possible to convert this to add backgrounds to all the Geopak labels in a file model
Peter Violette said:I have code made by Chuck Rheault
That's a name from the past...
Regards, Jon Summers LA Solutions
Thanks. I am an absolute novice at this, and looks like I need to spend some time with it as I am lost.
Peter Violette said: I am an absolute novice at this, and looks like I need to spend some time with it
Here's an example that uses VBA to scan for a cell.
Here's what I am confused by, the process to select the element looks like it is at the bottom, but is told to run first by the first line in the code?
Example 2 here looks like it does what I want by scanning for text.
Would I be correct by extracting the scan from the example, and replacing all "ILocateCommandEvents" with it? Am I in the ballpark in my amateur thinking? I understand the logic:
Implements ILocateCommandEvents Private Function ApplyTextBackground(el As element, marginX As Double, marginY As Double) As Boolean Dim border As Point2d ' remove background if already exists If el.AsTextElement.TextStyle.BorderAndBackgroundVisible = True Then el.Redraw msdDrawingModeErase el.AsTextElement.TextStyle.BorderAndBackgroundVisible = False Else border.X = marginX * 0.125 border.Y = marginY * 0.48 el.AsTextElement.TextStyle.BackgroundFillColor = 255 el.AsTextElement.TextStyle.BorderColor = 255 el.AsTextElement.TextStyle.BorderMargins = border el.AsTextElement.TextStyle.BorderAndBackgroundVisible = True End If el.Redraw el.Rewrite End Function Private Sub Class_Initialize() End Sub Private Sub ILocateCommandEvents_Accept(ByVal element As element, _ point As Point3d, ByVal view As view) ' base border on text size for TextElements If element.Type = msdElementTypeText Then ApplyTextBackground element, element.AsTextElement.TextStyle.Width, _ element.AsTextElement.TextStyle.Height ' base border on line spacing for TextNodeElements ElseIf element.Type = msdElementTypeTextNode Then Dim ee As ElementEnumerator Set ee = element.AsTextNodeElement.GetSubElements Do While ee.MoveNext ApplyTextBackground ee.Current, element.AsTextNodeElement.LineSpacing, _ element.AsTextNodeElement.LineSpacing Loop ElseIf element.Type = msdElementTypeCellHeader Then Dim eee As ElementEnumerator Set ee = element.AsCellElement.GetSubElements Do While ee.MoveNext If ee.Current.Type = msdElementTypeText Then ApplyTextBackground ee.Current, ee.Current.AsTextElement.TextStyle.Width, _ ee.Current.AsTextElement.TextStyle.Height ElseIf ee.Current.Type = msdElementTypeTextNode Then Set eee = ee.Current.AsTextNodeElement.GetSubElements Do While eee.MoveNext If eee.Current.Type = msdElementTypeText Then ApplyTextBackground eee.Current, ee.Current.AsTextNodeElement.LineSpacing, _ ee.Current.AsTextNodeElement.LineSpacing End If Loop End If Loop End If element.Redraw msdDrawingModeNormal view.Redraw CommandState.StartLocate New clsSetTextBackground End Sub Private Sub ILocateCommandEvents_Cleanup() End Sub Private Sub ILocateCommandEvents_Dynamics(point As Point3d, ByVal view As view, _ ByVal DrawMode As MsdDrawingMode) End Sub Private Sub ILocateCommandEvents_LocateFailed() End Sub Private Sub ILocateCommandEvents_LocateFilter(ByVal element As element, _ point As Point3d, Accepted As Boolean) ShowPrompt "Accept/Reject" Accepted = True End Sub Private Sub ILocateCommandEvents_LocateReset() End Sub Private Sub ILocateCommandEvents_Start() Dim lc As LocateCriteria Set lc = CommandState.CreateLocateCriteria(True) ShowCommand "Apply Text Background" ShowPrompt "Identify Text" lc.ExcludeAllTypes lc.IncludeType msdElementTypeText lc.IncludeType msdElementTypeCellHeader 'lc.IncludeType msdElementTypeTextNode CommandState.SetLocateCriteria lc CommandState.EnableAccuSnap End Sub
Peter Violette said:the process to select the element looks like it is at the bottom, but is told to run first by the first line in the code?
That class Implements ILocateCommandEvents. ILocateCommandEvents is a state machine. The code executes according to its current state, which changes as you locate/accept/change an element.
Implements ILocateCommandEvents
ILocateCommandEvents
One way to see what is going on is to add some debug diagnostics to the code. Then you can see what happens and when...
Private Sub ILocateCommandEvents_LocateFilter(ByVal element As element, _ point As Point3d, Accepted As Boolean) ShowPrompt "Accept/Reject" Accepted = True Debug.Print "ILocateCommandEvents_LocateFilter" End Sub
Private Sub ILocateCommandEvents_Start() Dim lc As LocateCriteria Set lc = CommandState.CreateLocateCriteria(True) ShowCommand "Apply Text Background" ShowPrompt "Identify Text" lc.ExcludeAllTypes lc.IncludeType msdElementTypeText lc.IncludeType msdElementTypeCellHeader 'lc.IncludeType msdElementTypeTextNode CommandState.SetLocateCriteria lc CommandState.EnableAccuSnap Debug.Print "ILocateCommandEvents_Start" End Sub
The debug messages are shown in VBA's Immediate Window.