Implementing extended criteria for some predefined schematic rules
CollapseRelatedElts.vb
' Copyright 2012 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 

Option Strict Off
Option Explicit On

<System.Runtime.InteropServices.ClassInterface(System.Runtime.InteropServices.ClassInterfaceType.None)> _
<System.Runtime.InteropServices.Guid(CollapseRelatedElts.GUID)> _
<System.Runtime.InteropServices.ProgId(CollapseRelatedElts.PROGID)> _
Public Class CollapseRelatedElts
  Implements ESRI.ArcGIS.Schematic.ISchematicCollapseRelatedElementsExtended

  Public Const GUID As String = "BB27AD60-32D9-4f54-B7BB-D170CC15D48E"
  Public Const PROGID As String = "CustomExtCriteriaVB.CollapseRelatedElts"

  ' Register/unregister categories for this class
#Region "Component Category Registration"
  <System.Runtime.InteropServices.ComRegisterFunction()> _
  Public Shared Sub Register(ByVal CLSID As String)
    ESRI.ArcGIS.ADF.CATIDs.SchematicRulesExtendedCriteria.Register(CLSID)
  End Sub

  <System.Runtime.InteropServices.ComUnregisterFunction()> _
  Public Shared Sub Unregister(ByVal CLSID As String)
    ESRI.ArcGIS.ADF.CATIDs.SchematicRulesExtendedCriteria.Unregister(CLSID)
  End Sub
#End Region

#Region "ISchematicCollapseRelatedElementsExtended Implementations"
  Public ReadOnly Property Name() As String Implements ESRI.ArcGIS.Schematic.ISchematicCollapseRelatedElementsExtended.Name
    Get
      Return "Test extended collapse (VBNet)"
    End Get
  End Property

  Public Function SelectElementsToCollapse( _
   ByVal node As ESRI.ArcGIS.Schematic.ISchematicInMemoryFeatureNode, _
   ByVal relatedFeatures As ESRI.ArcGIS.Schematic.IEnumSchematicInMemoryFeature) _
  As ESRI.ArcGIS.Schematic.IEnumSchematicInMemoryFeature _
   Implements ESRI.ArcGIS.Schematic.ISchematicCollapseRelatedElementsExtended.SelectElementsToCollapse

    On Error Resume Next
    ' get feature
    Dim esriFeature As ESRI.ArcGIS.Geodatabase.IFeature
    esriFeature = CType(node, ESRI.ArcGIS.Geodatabase.IFeature)
    If (esriFeature Is Nothing) Then Return Nothing

    ' get feature class
    Dim esriFeatureClass As ESRI.ArcGIS.Geodatabase.IFeatureClass
    esriFeatureClass = CType(esriFeature.Class, ESRI.ArcGIS.Geodatabase.IFeatureClass)

    ' if not the right feature class do nothing
    If (esriFeatureClass.AliasName <> "plants") Then Return Nothing

    Dim okToCollapse As Boolean = True

    relatedFeatures.Reset()

    ' Test if you want to collapse related feature
    'Dim schemElement As ESRI.ArcGIS.Schematic.ISchematicElement = relatedElements.Next
    'Do While (schemElement IsNot Nothing AndAlso okToCollapse)
    '  okToCollapse = CanCollapseElement(schemElement)
    '  schemElement = relatedElements.Next
    'Loop

    If Not okToCollapse Then
      ' if nothing to collapse return nothing
      Return Nothing
    ElseIf RelatedFeatures.Count = 0 Then
      ' create a list of feature to collapse
      Dim enumCollapse As EnumCollapsedElts
      enumCollapse = New EnumCollapsedElts()

      ' get incident links
      Dim enumLinks As ESRI.ArcGIS.Schematic.IEnumSchematicInMemoryFeatureLink
      enumLinks = node.GetIncidentLinks(Schematic.esriSchematicEndPointType.esriSchematicOriginOrExtremityNode)
      If enumLinks Is Nothing Then Return enumCollapse
      If enumLinks.Count > 1 Then
        enumLinks.Reset()
        ' for each link 
        Dim schemLink As ESRI.ArcGIS.Schematic.ISchematicInMemoryFeatureLink
        schemLink = enumLinks.Next
        If schemLink IsNot Nothing Then
          ' Add node to collapse
          enumCollapse.Add(node)

          While schemLink IsNot Nothing
            ' Add link to collapse
            enumCollapse.Add(schemLink)
            schemLink = enumLinks.Next
          End While
        End If
      End If
      Return enumCollapse
    Else
      Return relatedFeatures
    End If
  End Function
#End Region
End Class