TraceResultsWindow Command
TraceResultsWin.cls

' Copyright 2008 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 use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.
' 




Option Explicit

Implements IDockableWindowDef

Private m_pApp As IApplication
Private m_pMXDoc As IMxDocument
Private WithEvents m_pMapEvent As Map           ' Listen for the Map events
Private m_cResultSets As Collection  'Holds the different trace result sets
Private m_pGeomNet As IGeometricNetwork
Private m_bDrawComplex As Boolean

Private WithEvents m_AddButton As CommandButton
Private WithEvents m_RemoveButton As CommandButton
Private WithEvents m_RemoveAllButton As CommandButton
Private WithEvents m_SelectionSetButton As CommandButton
Private WithEvents m_LayerSubsetsButton As CommandButton
Private WithEvents m_PathCostButtton As CommandButton
Private WithEvents m_UpButton As CommandButton
Private WithEvents m_DownButtton As CommandButton

Private Property Get IDockableWindowDef_Caption() As String
  IDockableWindowDef_Caption = "Trace Results Window"
End Property

Private Property Get IDockableWindowDef_ChildHWND() As esriSystem.OLE_HANDLE
  ' The dockable window will consist of a list box, so pass back the hWnd of
  ' the listbox on a form
  IDockableWindowDef_ChildHWND = frmTraceResults.picControls.hWnd
End Property

Private Property Get IDockableWindowDef_Name() As String
  IDockableWindowDef_Name = "Trace Results"
End Property

Private Sub IDockableWindowDef_OnCreate(ByVal hook As Object)
  ' The hook argument is a pointer to Application object.
  ' Establish a hook to the application
  Set m_pApp = hook
  Set m_pMXDoc = m_pApp.Document
  
  If Not m_pMapEvent Is m_pMXDoc.FocusMap Then
    Set m_pMapEvent = m_pMXDoc.FocusMap
  End If
  
  Set m_cResultSets = New Collection
  
  Set m_AddButton = frmTraceResults.cmdAddLast
  Set m_RemoveButton = frmTraceResults.cmdRemove
  Set m_RemoveAllButton = frmTraceResults.cmdRemoveAll
  Set m_SelectionSetButton = frmTraceResults.cmdSelectionSet
  Set m_LayerSubsetsButton = frmTraceResults.cmdLayerSubsets
  Set m_PathCostButtton = frmTraceResults.cmdPathCost
  Set m_UpButton = frmTraceResults.cmdUp
  Set m_DownButtton = frmTraceResults.cmdDown
End Sub

Private Sub IDockableWindowDef_OnDestroy()
  Set m_pMapEvent = Nothing
  Set m_pMXDoc = Nothing
  Set m_pApp = Nothing
  Set m_cResultSets = Nothing
  Set m_pGeomNet = Nothing
  Set m_AddButton = Nothing
  Set m_RemoveButton = Nothing
  Set m_RemoveAllButton = Nothing
  Set m_SelectionSetButton = Nothing
  Set m_LayerSubsetsButton = Nothing
  Set m_PathCostButtton = Nothing
  Set m_UpButton = Nothing
  Set m_DownButtton = Nothing
End Sub

Private Property Get IDockableWindowDef_UserData() As Variant

End Property

Private Sub m_pMapEvent_AfterDraw(ByVal Display As esriDisplay.IDisplay, ByVal phase As esriCarto.esriViewDrawPhase)
On Error GoTo ErrHandler:
  Dim lCount As Long, pResults As clsTraceResults
  Dim pUID As New UID, pNetAnalExt As INetworkAnalysisExtResults
  
  pUID = "esriEditorExt.UtilityNetworkAnalysisExt"
  Set pNetAnalExt = m_pApp.FindExtensionByCLSID(pUID)
  m_bDrawComplex = pNetAnalExt.DrawComplex
  
  If phase = esriViewGraphics Then
    If m_cResultSets.Count > 0 And frmTraceResults.lvwTraceResults.ListItems.Count = m_cResultSets.Count Then
      For lCount = 1 To frmTraceResults.lvwTraceResults.ListItems.Count
        If frmTraceResults.lvwTraceResults.ListItems.Item(lCount).Checked Then
          Set pResults = m_cResultSets.Item(lCount)
          UTIL_DrawResults Display, pResults.EdgeSet, pResults.JunctionSet, pResults.Color
        End If
      Next lCount
    End If
  End If
  
  Exit Sub
  
ErrHandler:
  MsgBox "m_pMap_AfterDraw - " & Erl & " - " & Err.Description
End Sub

Private Function UTIL_GetLayer(pFeatClass As IFeatureClass, pVisibilityCheck As Boolean) As IFeatureLayer
'Routine for returning a feature layer based on a feature class, if pVisibilityCheck
'is true, then only return the layer when it is visible
On Error GoTo ErrHandler:
  Dim pDoc As IMxDocument, iLoop As Integer
  Dim pMap As IMap
  Dim pFLayer As IFeatureLayer
  Set pDoc = m_pApp.Document
  Set pMap = pDoc.FocusMap
  Set UTIL_GetLayer = Nothing
  For iLoop = 0 To pMap.LayerCount - 1
    If TypeOf pMap.Layer(iLoop) Is IFeatureLayer Then
      Set pFLayer = pMap.Layer(iLoop)
      If ObjPtr(pFLayer.FeatureClass) = ObjPtr(pFeatClass) Then
        If pVisibilityCheck Then
          If pMap.Layer(iLoop).Visible Then
            Set UTIL_GetLayer = pFLayer
          Else
            Set UTIL_GetLayer = Nothing
          End If
        Else
          Set UTIL_GetLayer = pFLayer
        End If
        Exit For
      End If
    End If
  Next iLoop
  
  Exit Function

ErrHandler:
  MsgBox "Util_GetLayer - " & Err.Description
  Exit Function
End Function

Public Sub UTIL_DrawResults(pDisplay As IDisplay, pEdgeSet As IEnumNetEID, pJuncSet As IEnumNetEID, pColor As IColor)
'Routine for drawing the results of a trace
On Error GoTo ErrHand:
  'Only display results (do not create selection set)
  If m_pGeomNet Is Nothing Then Exit Sub
  
  Dim pFeatureClass As IFeatureClass, pEnumFC As IEnumFeatureClass
  
  'Draw Complex Edges
  Set pEnumFC = m_pGeomNet.ClassesByType(esriFTComplexEdge)
  Set pFeatureClass = pEnumFC.Next
  While Not pFeatureClass Is Nothing
    If Not UTIL_GetLayer(pFeatureClass, True) Is Nothing Then
      UTIL_DrawLayer pEdgeSet, pFeatureClass, True, pDisplay, esriFTComplexEdge, pColor
    End If
    Set pFeatureClass = pEnumFC.Next
  Wend
  
  'Draw Simple Edges
  Set pEnumFC = m_pGeomNet.ClassesByType(esriFTSimpleEdge)
  Set pFeatureClass = pEnumFC.Next
  While Not pFeatureClass Is Nothing
    If Not UTIL_GetLayer(pFeatureClass, True) Is Nothing Then
      UTIL_DrawLayer pEdgeSet, pFeatureClass, True, pDisplay, esriFTSimpleEdge, pColor
    End If
    Set pFeatureClass = pEnumFC.Next
  Wend
  
  'Draw Simple Junctions
  Set pEnumFC = m_pGeomNet.ClassesByType(esriFTSimpleJunction)
  Set pFeatureClass = pEnumFC.Next
  While Not pFeatureClass Is Nothing
    If Not UTIL_GetLayer(pFeatureClass, True) Is Nothing Then
      UTIL_DrawLayer pJuncSet, pFeatureClass, True, pDisplay, esriFTSimpleJunction, pColor
    End If
    Set pFeatureClass = pEnumFC.Next
  Wend
  
  Exit Sub
  
ErrHand:
  MsgBox "UTIL_DrawResults - " & Err.Description
  Exit Sub
End Sub

Private Sub UTIL_DrawLayer(pSelection As IEnumNetEID, pFeatureClass As IFeatureClass, _
  needDuplicates As Boolean, pDisplay As IDisplay, pFeatType As esriFeatureType, pColor As IColor)
'Routine for drawing the layers in the result set of a trace
'
'Layers are drawn by generating a whereclause containing the OIDs of the features in the trace
'results.  The whereclause is then sent to UTIL_DrawFeatures to select the features and
'display them.
On Error GoTo ErrHand:
  
  Dim whereClause As String, featureCount As Long, pNetwork As INetwork
  Dim firstTime As Boolean, pNetElements As INetElements
  Dim pClassID As Long, elementEID As Long
  Dim pUserClassID As Long, pUserID As Long, pUserSubID As Long
  Set pNetwork = m_pGeomNet.Network
  
  featureCount = 0
  firstTime = True
  Set pNetElements = pNetwork
  pClassID = pFeatureClass.FeatureClassID
  
  pSelection.Reset
  elementEID = pSelection.Next
  
  'Determine the layer name for use in the where clause
  Dim pDataset As IDataset, sLayerName As String
  Set pDataset = pFeatureClass
  sLayerName = pDataset.Name
  If pDataset.Workspace.Type = esriRemoteDatabaseWorkspace Then
    If InStr(1, sLayerName, ".", vbTextCompare) > 0 Then
      sLayerName = Mid(sLayerName, InStr(1, sLayerName, ".", vbTextCompare) + 1) + "."
    End If
  Else
    sLayerName = ""
  End If
  
  'Loop through the elements, determine and saving the feature ID of each
  Dim elementType As esriElementType, pApp As IApplication
  Dim pDoc As IMxDocument, pDrawComplex As Boolean
  Set pDoc = m_pApp.Document
  While elementEID <> 0
    If pFeatType = esriFTComplexEdge Or pFeatType = esriFTSimpleEdge Then
      pNetElements.QueryIDs elementEID, esriETEdge, pUserClassID, pUserID, pUserSubID
    Else
      pNetElements.QueryIDs elementEID, esriETJunction, pUserClassID, pUserID, pUserSubID
    End If
        
    If pClassID = pUserClassID Then
      'Determine whether to draw complex features by their elements or not
      Select Case pFeatType
      Case esriFTComplexJunction
        pDrawComplex = True
      Case esriFTComplexEdge
        If m_bDrawComplex Then
          pDrawComplex = True
        Else
          pDrawComplex = False
        End If
      Case Else
        pDrawComplex = False
      End Select
      
      If pDrawComplex Then
        ' if we are looking at a complex edge, then we need to draw it independently
        ' to make sure we draw only the elements of the edge that were traced
        Dim pLineSymbol As ISimpleLineSymbol
        Set pLineSymbol = UTIL_CreateLineSymbol(255, 255, 0, 2)
        If elementType = esriETEdge Then
          Dim pNetworkFeature As INetworkFeature
          Set pNetworkFeature = pFeatureClass.GetFeature(pUserID)

          'Check to see if current feature is within the current extent envelope
          Dim theEnv As IEnvelope, pFeat As IFeature
          Set theEnv = New Envelope
          theEnv.XMin = pDoc.ActiveView.Extent.XMin
          theEnv.XMax = pDoc.ActiveView.Extent.XMax
          theEnv.YMin = pDoc.ActiveView.Extent.YMin
          theEnv.YMax = pDoc.ActiveView.Extent.YMax
          Set pFeat = pNetworkFeature
          theEnv.Intersect pFeat.Extent

          If Not theEnv.IsEmpty Then
            Dim pGeometry As IGeometry, pEdgeFeat
            Set pEdgeFeat = pNetworkFeature
            Set pGeometry = pEdgeFeat.GeometryForEdgeElement(pUserSubID)
            pLineSymbol.Color = pColor
          End If
        End If
      Else
        'Simple features
        If firstTime = True Then
          whereClause = sLayerName & pFeatureClass.OIDFieldName & " in ( " & pUserID
          firstTime = False
        Else
          whereClause = whereClause & "," & pUserID
        End If
        featureCount = featureCount + 1
         
        If featureCount > 500 Then
          whereClause = whereClause + ")"
          UTIL_DrawFeatures pFeatureClass, whereClause, pDisplay, pColor
          featureCount = 0
          firstTime = True
        End If
      End If
    End If
    elementEID = pSelection.Next
  Wend
  
  If featureCount > 0 Then
    whereClause = whereClause + ")"
    UTIL_DrawFeatures pFeatureClass, whereClause, pDisplay, pColor
  End If
  
  Exit Sub
ErrHand:
  MsgBox "UTIL_DrawLayer - " & Err.Description
  Exit Sub
End Sub

Private Sub UTIL_DrawFeatures(pFeatureClass As IFeatureClass, whereClause As String, _
 pDisplay As IDisplay, pColor As IColor)
'Routine for drawing the individual features in the result set of a trace
On Error GoTo ErrHand:

  'Select the feature to draw based on a query of the OIDs found in UTIL_DrawLayer
  Dim pFilter As ISpatialFilter, pApp As IApplication, pDoc As IMxDocument
  Set pApp = m_pApp
  Set pFilter = New SpatialFilter
  pFilter.whereClause = whereClause
  pFilter.SubFields = pFeatureClass.ShapeFieldName & ", " & pFeatureClass.OIDFieldName
  pFilter.GeometryField = pFeatureClass.ShapeFieldName
  Set pDoc = pApp.Document
  Set pFilter.Geometry = pDoc.ActiveView.Extent
  pFilter.SpatialRel = esriSpatialRelEnvelopeIntersects
  
  Dim pFeatureCursor As IFeatureCursor
  Set pFeatureCursor = pFeatureClass.Search(pFilter, True)
  
  Dim pLineSymbol As ISimpleLineSymbol
  Set pLineSymbol = UTIL_CreateLineSymbol(255, 255, 0, 2)
  pLineSymbol.Color = pColor
  Dim pMarkerSymbol As ISimpleMarkerSymbol
  Set pMarkerSymbol = UTIL_CreateMarkerSymbol(255, 255, 0, esriSMSCircle, 6)
  pMarkerSymbol.Color = pColor
  
  'Loop through the cursor drawing the features that were found
  Dim pGeometry As IGeometry, pFeature As IFeature
  If Not pFeatureCursor Is Nothing Then
    Set pFeature = pFeatureCursor.NextFeature
    While Not pFeature Is Nothing
      Set pGeometry = pFeature.Shape
      Select Case pFeatureClass.FeatureType
      Case esriFTSimpleEdge
        pDisplay.SetSymbol pLineSymbol
        pDisplay.DrawPolyline pGeometry
      Case esriFTComplexEdge
        If m_bDrawComplex Then
        Else
          pDisplay.SetSymbol pLineSymbol
          pDisplay.DrawPolyline pGeometry
        End If
      Case esriFTSimpleJunction
        pDisplay.SetSymbol pMarkerSymbol
        pDisplay.DrawPoint pGeometry
      End Select
      Set pFeature = pFeatureCursor.NextFeature
    Wend
  End If
  
  Exit Sub
ErrHand:
  MsgBox "UTIL_DrawFeatures - " & Err.Description
  Exit Sub
End Sub

Public Sub UTIL_MakeSelectionSets(lCount As Long)
'Routine for converting a trace result set into a selection set
On Error GoTo ErrHand:
  'If the "Create selection set" option is turned on
  Dim pWork As IWorkspace
  Dim pNetElems As INetElements
  Set pWork = m_pGeomNet.FeatureDataset.Workspace
  Set pNetElems = m_pGeomNet.Network
  
  Dim pLayer As ILayer, iLoop As Integer
  Dim pFLayer As IFeatureLayer
  
  Dim pDoc As IMxDocument
  Dim pMap As IMap
  Dim pFDataset As IFeatureDataset
  Dim pGeomNetwork As IGeometricNetwork
  Dim pSelEvents As ISelectionEvents
  Set pDoc = m_pApp.Document
  Set pMap = pDoc.FocusMap
  
  'Clear the current selection
  pMap.ClearSelection
  
  Dim fcCount As Long, pFeatureClass As IFeatureClass, pNetClass As INetworkClass
  Dim pFCContainer As IFeatureClassContainer, pAllColl As New Collection, pEIDColl As Collection
  Dim lLoop As Long, lEIDs() As Long
  Set pFDataset = m_pGeomNet.FeatureDataset
  If pFDataset Is Nothing Then Exit Sub
  
  Set pFCContainer = pFDataset
  fcCount = pFCContainer.ClassCount
  
  'Open a collection on each network layer so that we can add select OIDs to it.  Collections are
  'used because they are quicker than adding directly to the selection set.  When you add an OID
  'to a collection it will check to make sure they OID is already present.
  For iLoop = 0 To pMap.LayerCount - 1
    Set pLayer = pMap.Layer(iLoop)
    If TypeOf pLayer Is IFeatureLayer Then
      Set pFLayer = pLayer
      Set pFeatureClass = pFLayer.FeatureClass
      If TypeOf pFeatureClass Is INetworkClass Then
        Set pNetClass = pFeatureClass
        If Not pNetClass.GeometricNetwork Is Nothing Then
          Set pGeomNetwork = pNetClass.GeometricNetwork
          If pFDataset.Name = pGeomNetwork.FeatureDataset.Name Then
            Set pEIDColl = New Collection
            pAllColl.Add pEIDColl, CStr(pFeatureClass.FeatureClassID)
          End If
          
          Set pGeomNetwork = Nothing
        End If
      End If
    End If
  Next iLoop
  
  Dim pJuncSet As IEnumNetEID, pEdgeSet As IEnumNetEID, pResults As clsTraceResults
  Set pResults = m_cResultSets.Item(lCount)
  Set pJuncSet = pResults.JunctionSet
  Set pEdgeSet = pResults.EdgeSet
  pJuncSet.Reset
  pEdgeSet.Reset
  Dim elementEID As Long, elementOID As Long, elementClassID As Long, elementSub As Long
  Dim pMyColl As Collection

  'Transfer the list of selected EID to the collection for each layer
  elementEID = pJuncSet.Next
  While elementEID <> 0
    pNetElems.QueryIDs elementEID, esriETJunction, elementClassID, elementOID, elementSub
    Set pMyColl = pAllColl.Item(CStr(elementClassID))
    On Error GoTo Skip:
    pMyColl.Add elementOID, CStr(elementOID)
    On Error GoTo ErrHand:
    
    elementEID = pJuncSet.Next
  Wend
  
  elementEID = pEdgeSet.Next
  While elementEID <> 0
    pNetElems.QueryIDs elementEID, esriETEdge, elementClassID, elementOID, elementSub
    Set pMyColl = pAllColl.Item(CStr(elementClassID))
    On Error GoTo Skip:
    pMyColl.Add elementOID, CStr(elementOID)
    On Error GoTo ErrHand:
    
    elementEID = pEdgeSet.Next
  Wend
  
  'Convert the collections to an array and then add the array as a list (AddList) to the
  'selection set for each layer.
  Dim pFeatureSelection As IFeatureSelection
  For iLoop = 0 To pMap.LayerCount - 1
    Set pLayer = pMap.Layer(iLoop)
    If TypeOf pLayer Is IFeatureLayer Then
      Set pFLayer = pLayer
      Set pFeatureClass = pFLayer.FeatureClass
      If TypeOf pFeatureClass Is INetworkClass And pFLayer.Selectable Then
        Set pNetClass = pFeatureClass
        If Not pNetClass.GeometricNetwork Is Nothing Then
          Set pGeomNetwork = pNetClass.GeometricNetwork
          If pFDataset.Name = pGeomNetwork.FeatureDataset.Name Then
            Set pMyColl = pAllColl.Item(CStr(pFeatureClass.FeatureClassID))
            If pMyColl.Count > 0 Then
              ReDim lEIDs(pMyColl.Count - 1)
              For lLoop = 0 To pMyColl.Count - 1
                lEIDs(lLoop) = pMyColl.Item(lLoop + 1)
              Next lLoop
              
              Set pFeatureSelection = pFLayer
              pFeatureSelection.SelectionSet.AddList pMyColl.Count, lEIDs(0)
            End If
          End If
        End If
      End If
    End If
  Next iLoop
  
  'Refresh the display and fire the selectionchanged event
  pDoc.ActiveView.Refresh
  Set pSelEvents = pDoc.FocusMap
  pSelEvents.SelectionChanged
  
  Exit Sub
  
Skip:   'Called when a duplicate OID is found with QueryIDs
  Resume Next
  
ErrHand:
  MsgBox "UTIL_MakeSelectionSets - " & Erl & " - " & Err.Description
  Exit Sub
End Sub

Public Function UTIL_CreateLineSymbol(lRed As Long, lGreen As Long, lBlue As Long, _
 Optional dWidth, Optional rop2, Optional style) As ISimpleLineSymbol
'Routine for creating a line symbol to display the trace results
  Dim pLineSymbol As ISimpleLineSymbol
  Set pLineSymbol = New SimpleLineSymbol
  Dim pColor As IRgbColor
  Set pColor = New RgbColor
  With pColor
    .Red = lRed
    .Green = lGreen
    .Blue = lBlue
  End With
  pLineSymbol.Color = pColor
  
  If Not IsMissing(dWidth) Then
    pLineSymbol.Width = dWidth
  End If
  
  If Not IsMissing(rop2) Then
    Dim pSymbol As ISymbol
    Set pSymbol = pLineSymbol
    pSymbol.rop2 = rop2
  End If

  If Not IsMissing(style) Then
    pLineSymbol.style = style
  End If

  Set UTIL_CreateLineSymbol = pLineSymbol
End Function

Public Function UTIL_CreateMarkerSymbol(lRed As Long, lGreen As Long, lBlue As Long, _
      Optional style, Optional dSize, Optional rop2) As ISimpleMarkerSymbol
'Routine for creating a marker symbol for displaying the results of a trace
  Dim pPtSym As ISimpleMarkerSymbol
  Set pPtSym = New SimpleMarkerSymbol
  Dim pColor As IRgbColor
  Set pColor = New RgbColor
  With pColor
    .Red = lRed
    .Blue = lBlue
    .Green = lGreen
  End With
  pPtSym.Color = pColor
  
  If Not IsMissing(style) Then
    pPtSym.style = style
  End If
  
  If Not IsMissing(dSize) Then
    pPtSym.Size = dSize
  End If
  
  If Not IsMissing(rop2) Then
    Dim pSymbol As ISymbol
    Set pSymbol = pPtSym
    pSymbol.rop2 = rop2
  End If
  
  Set UTIL_CreateMarkerSymbol = pPtSym
End Function

Private Sub m_AddButton_Click()
On Error GoTo ErrHand:
  'Save the results in the results collection
  Dim pResults As New clsTraceResults, lIndex As Long
  Dim pUID As New UID, pNetUtil As IUtilityNetworkAnalysisExt
  Dim pTasks As ITraceTasks, pTraceResults As ITraceTaskResults
  Dim pNetAnalExt As INetworkAnalysisExt, pNetAnalExtColor As INetworkAnalysisExtResultColor
  Dim pPathResults As ITracePathTaskResults, pNetResults As INetworkAnalysisExtResults
  
  pUID = "esriEditorExt.UtilityNetworkAnalysisExt"
  Set pNetUtil = m_pApp.FindExtensionByCLSID(pUID)
  Set pTasks = pNetUtil
  If pTasks.CurrentTask Is Nothing Then
    MsgBox "There is no current Trace Task!!"
    Exit Sub
  End If
  Set pTraceResults = pTasks.CurrentTask
  
  'Check for something in the results
  If pTraceResults.ResultEdges Is Nothing Then
    MsgBox "There are no trace results!!!"
    Exit Sub
  End If
  
  Set pNetAnalExtColor = pNetUtil
  Set pResults.EdgeSet = pTraceResults.ResultEdges
  Set pResults.JunctionSet = pTraceResults.ResultJunctions
  Set pResults.Color = pNetAnalExtColor.Color
  If TypeOf pTraceResults Is ITracePathTaskResults Then
    Set pPathResults = pTraceResults
    pResults.PathCost = pPathResults.TotalCost
  Else
    pResults.PathCost = 0
  End If
  m_cResultSets.Add pResults
  
  lIndex = frmTraceResults.lvwTraceResults.ListItems.Count + 1
  frmTraceResults.lvwTraceResults.ListItems.Add lIndex, , pTasks.CurrentTask.Name
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex).Checked = True
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex).ForeColor = pResults.Color.RGB
  
  Set pNetAnalExt = pNetUtil
  Set m_pGeomNet = pNetAnalExt.CurrentNetwork
  
  'Clear the results from the Utility Network Analysis toolbar (since the results will now draw through
  'this tool/extension.
  Set pNetResults = pNetAnalExtColor
  pNetResults.ClearResults
  
  Exit Sub
ErrHand:
  MsgBox "m_AddButton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_LayerSubsetsButton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long, lLoop As Long, pFLayer As IFeatureLayer
  Dim pFeatSel As IFeatureSelection, pNewFLayer As IFeatureLayer
  Dim pGeoFLayer As IGeoFeatureLayer, pNewGeoFLayer As IGeoFeatureLayer
  Dim pDoc As IMxDocument, pFLDef As IFeatureLayerDefinition
  Dim pMap As IMap
  Dim pGLayer As IGroupLayer, pGroup As ILayer
  
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  Set pDoc = m_pApp.Document
  Set pMap = pDoc.FocusMap
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  
  'First create the selections based on the selected trace
  UTIL_MakeSelectionSets lIndex
  
  'Create a new group layer to hold the selection layers
  Set pGroup = New GroupLayer
  pGroup.Name = frmTraceResults.lvwTraceResults.ListItems.Item(lIndex).Text & " Results"
  Set pGLayer = pGroup
  
  'Loop through the layers and find the ones with selection sets.  Create new layers from these.
  'Also turn off the display of each layer as you go.
  For lLoop = 0 To pMap.LayerCount - 1
    pMap.Layer(lLoop).Visible = False
    If TypeOf pMap.Layer(lLoop) Is IFeatureLayer Then
      Set pFLayer = pMap.Layer(lLoop)
      Set pFeatSel = pFLayer
      If pFeatSel.SelectionSet.Count > 0 Then
        Set pFLDef = pFLayer
        Set pGeoFLayer = pFLayer
        Set pNewFLayer = pFLDef.CreateSelectionLayer(pFLayer.Name & "_1", True, "", "")
        Set pNewGeoFLayer = pNewFLayer
        Set pNewGeoFLayer.Renderer = pGeoFLayer.Renderer
        pGLayer.Add pNewFLayer
      End If
    End If
  Next lLoop
  pMap.AddLayer pGLayer
  
  pDoc.ActiveView.Refresh

  Exit Sub
ErrHand:
  MsgBox "m_LayerSubsetsButton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_PathCostButtton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long, pResults As clsTraceResults
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  Set pResults = m_cResultSets.Item(lIndex)
  If pResults.PathCost = 0 Then
    MsgBox "Path Cost can only be shown for Trace Path results!!!"
  Else
    MsgBox "Path Cost: " & CStr(pResults.PathCost)
  End If
  
  Exit Sub
ErrHand:
  MsgBox "m_PathCostButtton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_RemoveAllButton_Click()
  Set m_cResultSets = New Collection
  frmTraceResults.lvwTraceResults.ListItems.Clear
End Sub

Private Sub m_RemoveButton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  m_cResultSets.Remove lIndex
  frmTraceResults.lvwTraceResults.ListItems.Remove lIndex
  
  Exit Sub
ErrHand:
  MsgBox "m_RemoveButton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_SelectionSetButton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  UTIL_MakeSelectionSets lIndex
  
  Exit Sub
ErrHand:
  MsgBox "m_SelectionSetButton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_UpButton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long, pResults As clsTraceResults, sName As String
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  If lIndex = 1 Then Exit Sub
  
  Set pResults = m_cResultSets.Item(lIndex)
  sName = frmTraceResults.lvwTraceResults.ListItems.Item(lIndex).Text
  
  'Remove it
  m_cResultSets.Remove lIndex
  frmTraceResults.lvwTraceResults.ListItems.Remove lIndex
  
  'Add it back at new position
  m_cResultSets.Add pResults, , lIndex - 1
  frmTraceResults.lvwTraceResults.ListItems.Add lIndex - 1, , sName
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex - 1).Checked = True
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex - 1).ForeColor = pResults.Color.RGB
  
  Exit Sub
ErrHand:
  MsgBox "m_UpButton_Click - " & Erl & " - " & Err.Description
End Sub

Private Sub m_DownButtton_Click()
On Error GoTo ErrHand:
  Dim lIndex As Long, pResults As clsTraceResults, sName As String
  If frmTraceResults.lvwTraceResults.ListItems.Count = 0 Then Exit Sub
  lIndex = frmTraceResults.lvwTraceResults.SelectedItem.Index
  If lIndex = frmTraceResults.lvwTraceResults.ListItems.Count Then Exit Sub
  
  Set pResults = m_cResultSets.Item(lIndex)
  sName = frmTraceResults.lvwTraceResults.ListItems.Item(lIndex).Text
  
  'Remove it
  m_cResultSets.Remove lIndex
  frmTraceResults.lvwTraceResults.ListItems.Remove lIndex
  
  'Add it back at new position
  m_cResultSets.Add pResults, , , lIndex
  frmTraceResults.lvwTraceResults.ListItems.Add lIndex + 1, , sName
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex + 1).Checked = True
  frmTraceResults.lvwTraceResults.ListItems.Item(lIndex + 1).ForeColor = pResults.Color.RGB

  Exit Sub
ErrHand:
  MsgBox "m_DownButtton_Click - " & Erl & " - " & Err.Description
End Sub