The SDK example displayrule is providing keyins to:
In V8i generation next to named groups also itemsets can be created and one strong feature of itemsets is to allow colorize namedgroups.
In CONNECT Edition (CE) the displayrules as option of displaystyles were introduced to allow also colorizing named groups.
The idea of the following basic VBA example is automate the process of creating displayrules from given namedgroups in the current active DGN.
The VBA code example is iterating all namedgroup elements and is creating a unique displayrule for each namedgroup.
As requirement the MicroStation SDK example app displayrule (.ma and .dll) needs to be present (recommended to be stored with building the example in ..\mdlapps folder of the MS installation)
Example keyins can be found in the readme.txt with the displayrule source code example in MS SDK installation.
The displayrule source code readme.txt will be updated with the MS 2023 SDK with examples to demonstrate the syntax to create dsiplayrules using the displayrule app.
Please feel free to test this VBA and customize for own needs.
Option Explicit
Sub DefineDisplayRulesFromNG()
Dim ee As ElementEnumerator
Dim sc As New ElementScanCriteria
Dim ng As NamedGroupElement
Dim sCmd As String
Dim sCmdCreate As String
Dim sCmdModify As String
Dim sRuleset As String
Dim ngCount As Integer
' requires displayrule app available:
CadInputQueue.SendKeyin "mdl load displayrule"
Dim co As Integer
co = 1 ' start color #
sRuleset = "NG" ' name of ruleset
CadInputQueue.SendKeyin "displayrule create ruleset " + sRuleset
sCmdCreate = "displayrule create rule " + Chr(34) + sRuleset + Chr(34) + " " + Chr(34) + "element.DgnElementSchema::GraphicalElement::Groups.AnyMatches(X=>X.Name="
sCmdModify = "displayrule modify rule " + Chr(34) + sRuleset + Chr(34) + " " + Chr(34) + "element.DgnElementSchema::GraphicalElement::Groups.AnyMatches(X=>X.Name="
sc.ExcludeAllTypes
sc.IncludeType msdElementTypeNamedGroupHeader
Set ee = ActiveModelReference.ControlElementCache.Scan(sc)
' Iterating all named groups and create a displayrule with unique color for each named group:
Do While ee.MoveNext
Set ng = ee.Current
If Len(ng.Name) > 0 Then
ngCount = ngCount + 1
sCmd = sCmdCreate + "\" + Chr(34) + ng.Name + "\" + Chr(34) + Chr(34) + ") " + Chr(34) + "ColorOverride" + Chr(34)
' Create display rule, override Color is hard coded in app:
CadInputQueue.SendKeyin sCmd
sCmd = sCmdModify + "\" + Chr(34) + ng.Name + "\" + Chr(34) + Chr(34) + ") " + Chr(34) + "ColorOverride" + Chr(34) + " " + Chr(34) + CStr(co) + Chr(34)
' modify just created rule to use new color
CadInputQueue.SendKeyin sCmd
co = co + 1
co = co Mod 256
End If
Loop
End Sub