Valence Display
ValenceAll.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.
' 




'
'Title: Valence Display Tool
'Created: November 17, 2000
'Revised: September 14, 2001
'Purpose: Display the number of edges connected to the visible junctions within the
'         current map extent.  Displaying the valence will help identify locations
'         where network connectivity is incorrect (i.e., things that are not connected).
'
'To use:
'1.) Register the valence tool as both an extension and a command.
'2.) Load network data into ArcMap.
'3.) Add the Display Valence command from the Valence Tools category to a toolbar.
'4.) Click on the button to toggle the display of valence information on.
'5.) Click the button a second time to turn the display off.

Option Explicit

Dim m_pApp As IApplication
Dim m_bSelection As Boolean
Dim WithEvents m_pMap As Map
Dim m_pSym0 As ISimpleTextSymbol
Dim m_pSym1 As ISimpleTextSymbol
Dim m_pSym2 As ISimpleTextSymbol

Implements ICommand
Implements IExtension

Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
  'Set the bitmap for the button depending on whether or not the valence display
  'is turned on (m_bSelection = True) or not.
  If m_bSelection Then
    ICommand_Bitmap = frmResources.picDrawValence.Picture.Handle
  Else
    ICommand_Bitmap = frmResources.picNoDraw.Picture.Handle
  End If
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Display Valence"
End Property

Private Property Get ICommand_Category() As String
  ICommand_Category = "Developer Samples"
End Property

Private Property Get ICommand_Checked() As Boolean
  ICommand_Checked = False
End Property

Private Property Get ICommand_Enabled() As Boolean
  ICommand_Enabled = True
End Property

Private Property Get ICommand_HelpContextID() As Long

End Property

Private Property Get ICommand_HelpFile() As String

End Property

Private Property Get ICommand_Message() As String
  ICommand_Message = "Valence Display"
End Property

Private Property Get ICommand_Name() As String
  ICommand_Name = "ValenceAllPrj.ValenceAll"
End Property

Private Sub ICommand_OnClick()
  Dim pDoc As IMxDocument, pActive As IActiveView
  Set pDoc = m_pApp.Document
  Set m_pMap = pDoc.FocusMap
  m_bSelection = Not m_bSelection
  
  'Refresh the map after the valence display has been toggled
  Set pActive = m_pMap
  pActive.Refresh
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
  Dim fnt As New StdFont
  Dim pTextColor As IRgbColor
  Dim pColor0 As IRgbColor, pColor1 As IRgbColor, pColor2 As IRgbColor
  Dim pFill0 As IFillSymbol, pFill1 As IFillSymbol, pFill2 As IFillSymbol
  Dim pMask0 As IMask, pMask1 As IMask, pMask2 As IMask
  
  Set m_pApp = hook
  m_bSelection = False

  'Initialize the text font to Arial 8 pt
  fnt.Name = "Arial"
  fnt.Size = 8

  'Initialize the text color as white
  Set pTextColor = New RgbColor
  pTextColor.Red = 255
  pTextColor.Blue = 255
  pTextColor.Green = 255
  
  'Initialize the fill colors:
  '  0 connected edges - green
  '  1 connected edge - red
  '  2 or more connected edges - blue
  Set pColor0 = New RgbColor
  pColor0.Blue = 0
  pColor0.Green = 254
  pColor0.Red = 0
  Set pColor1 = New RgbColor
  pColor1.Blue = 0
  pColor1.Green = 0
  pColor1.Red = 254
  Set pColor2 = New RgbColor
  pColor2.Blue = 254
  pColor2.Green = 0
  pColor2.Red = 0
  
  'Initialize the symbols
  Set m_pSym0 = New TextSymbol
  m_pSym0.Font = fnt
  m_pSym0.HorizontalAlignment = esriTHARight
  m_pSym0.VerticalAlignment = esriTVABottom
  Set pMask0 = m_pSym0
  pMask0.MaskSize = 2
  pMask0.MaskStyle = esriMSHalo
  Set pFill0 = New SimpleFillSymbol
  pFill0.Color = pColor0
  pFill0.Outline = Nothing
  Set pMask0.MaskSymbol = pFill0
  m_pSym0.Color = pTextColor

  Set m_pSym1 = New TextSymbol
  m_pSym1.Font = fnt
  m_pSym1.HorizontalAlignment = esriTHALeft
  m_pSym1.VerticalAlignment = esriTVABottom
  Set pMask1 = m_pSym1
  pMask1.MaskSize = 2
  pMask1.MaskStyle = esriMSHalo
  Set pFill1 = New SimpleFillSymbol
  pFill1.Color = pColor1
  pFill1.Outline = Nothing
  Set pMask1.MaskSymbol = pFill1
  m_pSym1.Color = pTextColor

  Set m_pSym2 = New TextSymbol
  m_pSym2.Font = fnt
  m_pSym2.HorizontalAlignment = esriTHARight
  m_pSym2.VerticalAlignment = esriTVATop
  Set pMask2 = m_pSym2
  pMask2.MaskSize = 2
  pMask2.MaskStyle = esriMSHalo
  Set pFill2 = New SimpleFillSymbol
  pFill2.Color = pColor2
  pFill2.Outline = Nothing
  Set pMask2.MaskSymbol = pFill2
  m_pSym2.Color = pTextColor

End Sub

Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Toggle valence display on and off"
End Property

Private Property Get IExtension_Name() As String
  IExtension_Name = "ValenceDisplay"
End Property

Private Sub IExtension_Shutdown()

End Sub

Private Sub IExtension_Startup(initializationData As Variant)
  Set m_pApp = initializationData
End Sub

Private Sub m_pMap_AfterDraw(ByVal Display As esriDisplay.IDisplay, ByVal phase As esriCarto.esriViewDrawPhase)
On Error GoTo ErrHand:
  'Draw valence after the geography draw phase has completed
  If Not m_bSelection Or phase <> esriViewGeography Then Exit Sub
  
  Dim pMap As IMap, pActive As IActiveView
  Dim pQuery As ISpatialFilter, pEnv As IEnvelope, pGeom As IGeometry
  Dim lLoop As Long, pFeatLayer As IFeatureLayer
  
  Set pMap = m_pMap
  Set pActive = m_pMap
  Set pQuery = New SpatialFilter
  pQuery.SpatialRel = esriSpatialRelIntersects
  Set pEnv = pActive.Extent
  Set pGeom = pEnv
  Set pQuery.Geometry = pGeom

  'Loop through the layers and draw valence numbers for those layers that are
  'visible and are simple junction features.
  For lLoop = 0 To pMap.LayerCount - 1
    If TypeOf pMap.Layer(lLoop) Is IFeatureLayer Then
      Set pFeatLayer = pMap.Layer(lLoop)
      If pFeatLayer.FeatureClass.FeatureType = esriFTSimpleJunction And _
       pFeatLayer.Visible = True Then
        DrawValence Display, pFeatLayer, pQuery
      End If
    End If
  Next lLoop
  
  Exit Sub
ErrHand:
  MsgBox "ViewRefreshed - " & Err.Description
  Exit Sub
End Sub

Sub DrawValence(pDisplay As IDisplay, pFeatLayer As IFeatureLayer, pQuery As ISpatialFilter)
On Error GoTo ErrHand:
'The DrawValence routine does a query for the layer passed in to determine the
'features from that layer within the current screen display.  The results are looped
'through and the DrawMyText routine is called for each feature returned by the query.
  Dim pFeatCur As IFeatureCursor
  Dim pTopo As INetTopology, pNetFeat As INetworkFeature
  Dim pFeature As IFeature, pJuncFeature As ISimpleJunctionFeature
  Dim numEdges As Long
  
  Set pFeatCur = pFeatLayer.Search(pQuery, True)
  Set pFeature = pFeatCur.NextFeature

  Do While Not pFeature Is Nothing
    Set pJuncFeature = pFeature
    Set pNetFeat = pFeature
    Set pTopo = pNetFeat.GeometricNetwork.Network

    'Determine the number of adjacent edges
    'and call the DrawMyText routine to display the results.
    numEdges = pTopo.GetAdjacentEdgeCount(pJuncFeature.EID)
    Select Case numEdges
    Case 0
      DrawMyText pFeature, pDisplay, 0, m_pSym0
    Case 1
      DrawMyText pFeature, pDisplay, 1, m_pSym1
    Case Else
      DrawMyText pFeature, pDisplay, numEdges, m_pSym2
    End Select
    
    Set pFeature = pFeatCur.NextFeature
  Loop
  
  Exit Sub
ErrHand:
  MsgBox "DrawValence - " & Err.Description
  Exit Sub
End Sub

Private Sub DrawMyText(inFeature As IFeature, Display As IDisplay, conCount As Long, pSym As ISimpleTextSymbol)
On Error GoTo Handler:
'The DrawMyText routine displays the number of connected edges next to the feature
'that is passed in.  The color of the text is based on the number of connected edges.
  With Display
    .SetSymbol pSym
    .DrawText inFeature.Shape, CStr(conCount)
  End With
  Exit Sub
  
Handler:
  MsgBox "DrawMyText - " & Err.Description
  Exit Sub
End Sub