' 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