VBA example to leverage the displayrule SDK example keyins


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