Network Analyst routing
ArcGIS_Routing_VBNet\App_Code\NetworkAnalystUtility.vb
' Copyright 2010 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.
' 




Imports Microsoft.VisualBasic
Imports System
Imports ESRI.ArcGIS.Server
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.NetworkAnalyst
Imports System.Collections
Imports System.Data
Imports System.Collections.Specialized
Imports ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer
Imports ESRI.ArcGIS.ADF.Web.Geometry

Namespace ESRI.ArcGIS.Server.Web.NetworkAnalyst
  ''' <summary>
  ''' Utility class for working with Network analyst
  ''' </summary>
  Public Class NetworkAnalystUtility
    ''' <summary>
    ''' Constructor
    ''' </summary>
    Public Sub New()
    End Sub

    ''' <summary>
    ''' Add network location
    ''' </summary>
    ''' <param name="naContext">Layer to add to</param>
    ''' <param name="locationClassName">Type of location to add</param>
    ''' <param name="point">Geometry of location</param>
    ''' <param name="locationName">Name of location</param>
    ''' <param name="tolerance">Tolerance to use</param>
    ''' <returns>Whether the location was added</returns>
    Public Shared Function AddLocation(ByVal naContext As INAContext, ByVal locationClassName As String, ByVal point As IPoint, ByVal locationName As String, ByVal tolerance As Double) As Boolean
      ' Get NAClass
      Dim naClass As INAClass = TryCast(naContext.NAClasses.ItemByName(locationClassName), INAClass)
      Dim featureClass As IFeatureClass = TryCast(naClass, IFeatureClass)
      Dim fields As IFields = featureClass.Fields

      ' Find the network location using the locator

      Dim naLocator As INALocator = naContext.Locator
      naLocator.SnapTolerance = tolerance
      Dim naLocation As INALocation = Nothing
      Dim outPoint As IPoint = Nothing
      Dim distanceFromPoint As Double = 0
      naLocator.QueryLocationByPoint(point, naLocation, outPoint, distanceFromPoint)

      ' Get total count of features in class (needed for Sequence)
      Dim count As Integer = featureClass.FeatureCount(Nothing)

      ' Create feature and set shape
      Dim feature As IFeature = featureClass.CreateFeature()
      CType(feature, IRowSubtypes).InitDefaultValues()
      feature.Shape = point

      ' Set field values for NALocation, Name, Sequence, Status

      ' Set NALocation
      CType(feature, INALocationObject).NALocation = naLocation

      ' Set name field
      If locationName.Trim().Length > 0 Then
        feature.Value(fields.FindField("Name")) = locationName
      End If

      ' If Stops, set Sequence field (required to go from 1 to N)
      Dim sequenceFieldIndex As Integer = fields.FindField("Sequence")
      If sequenceFieldIndex >= 0 Then
        feature.Value(sequenceFieldIndex) = count + 1
      End If

      ' Set status if not located
      If naLocation.IsLocated = False Then
        feature.Value(fields.FindField("Status")) = esriNAObjectStatus.esriNAObjectStatusNotLocated
      End If

      ' Make sure to store the feature
      feature.Store()

      Return naLocation.IsLocated
    End Function

    ''' <summary>
    ''' Get directions
    ''' </summary>
    ''' <param name="naContext">The network analyst layer</param>
    ''' <param name="locationClassName">The output class name, e.g. Routes</param>
    ''' <param name="serverContext">The server context</param>
    ''' <returns>Route results</returns>
    Public Shared Function GetDirections(ByVal naContext As INAContext, ByVal locationClassName As String, ByVal serverContext As IServerContext) As NetworkAnalystRouteResult
      ' Check if we have results
      Dim result As INATraversalResultQuery = TryCast(naContext.Result, INATraversalResultQuery)
      If result Is Nothing Then
        Return Nothing
      End If
      Dim resultCount As Integer = result.FeatureClass(esriNetworkElementType.esriNETEdge).FeatureCount(Nothing)
      If resultCount = 0 Then
        Return Nothing
      End If

      Dim naClass As INAClass = TryCast(naContext.NAClasses.ItemByName(locationClassName), INAClass)

      ' Get Result Features
      Dim fClass As IFeatureClass = TryCast(naClass, IFeatureClass)
      Dim resultSet As ESRI.ArcGIS.esriSystem.ISet
      Dim filter As IQueryFilter
      If Not serverContext Is Nothing Then
        resultSet = TryCast(serverContext.CreateObject("esriSystem.Set"), ISet)
        filter = TryCast(serverContext.CreateObject("esriGeodatabase.QueryFilter"), IQueryFilter)
      Else
        resultSet = New ESRI.ArcGIS.esriSystem.SetClass()
        filter = New QueryFilterClass()
      End If

      Dim cursor As ICursor = TryCast(fClass.Search(Nothing, False), ICursor)
      Dim row As IRow = cursor.NextRow()
      Do While Not row Is Nothing
        resultSet.Add(row)
        row = cursor.NextRow()
      Loop

      ' Prepare Directions
      Dim namedSet As INamedSet = naContext.Agents
      Dim agentName As String = namedSet.Name(0)
      Dim agent As INAStreetDirectionsAgent = TryCast(namedSet.ItemByName(agentName), INAStreetDirectionsAgent)
      Dim track As ITrackCancel
      If Not serverContext Is Nothing Then
        track = TryCast(serverContext.CreateObject("esriDisplay.CancelTracker"), ITrackCancel)
      Else
        track = New ESRI.ArcGIS.Display.CancelTrackerClass()
      End If
      Dim naAgent As INAAgent = TryCast(agent, INAAgent)
      naAgent.OnResultUpdated()
      agent.Execute(resultSet, track)

      ' Get Directions

      Dim nasResultItems As ArrayList = New ArrayList()
      Dim container As INAStreetDirectionsContainer = agent.DirectionsContainer
      Dim count As Integer = 0
      Dim columnName, columnValue As String
      Dim dataRow As DataRow
      Dim envelope As IEnvelope

      Dim i As Integer = 0
      Do While i < container.DirectionsCount
        Dim resultItem As NetworkAnalystRouteResult = New NetworkAnalystRouteResult()
        Dim streetDirections As INAStreetDirections = container.Directions(i)
        Dim streetDirection As INAStreetDirection = streetDirections.Summary
        Dim stringType As esriDirectionsStringType = esriDirectionsStringType.esriDSTGeneral
        ' Get Summary
        Dim summary As StringDictionary = New StringDictionary()
        summary("Route") = streetDirections.RouteName
        count = streetDirection.StringCount
        Dim k As Integer = 0
        Do While k < count
          stringType = streetDirection.StringType(k)
          columnName = GetDirectionsStringType(stringType)
          columnValue = TryCast(summary(columnName), String)
          If Not columnValue Is Nothing AndAlso columnValue.Length > 0 Then
            summary(columnName) = columnValue & "<br>" & streetDirection.String(k)
          Else
            summary(columnName) = streetDirection.String(k)
          End If
          k += 1
        Loop

        envelope = streetDirection.Envelope


        ' Make sure we create a DefinitionSpatialReferenceInfo object in the case 
        ' where the spatial reference has a factory code.  Use it for the envelope's
        ' CoordinateSystem.  Otherwise, the envelope's CoordinateSystem will be an 
        ' IDSpatialReferenceInfo object which may cause the map to not draw correctly.
        Dim spatialReference As ISpatialReference = envelope.SpatialReference
        Dim spatialReferenceInfo As ESRI.ArcGIS.ADF.Web.SpatialReference.SpatialReferenceInfo = Nothing
        If Not spatialReference Is Nothing Then
          If spatialReference.FactoryCode <> 0 Then
            Dim esriSR As IESRISpatialReferenceGEN = TryCast(envelope.SpatialReference, IESRISpatialReferenceGEN)
            Dim definition As String = ""
            Dim bWrote As Integer = 0
            esriSR.ExportToESRISpatialReference(definition, bWrote)
            spatialReferenceInfo = New ESRI.ArcGIS.ADF.Web.SpatialReference.DefinitionSpatialReferenceInfo(definition)
          End If
        End If

        envelope.Expand(1.25, 1.25, True)
                Dim adf_envelope As ESRI.ArcGIS.ADF.Web.Geometry.Envelope = ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer.Local.Converter.FromIEnvelope(envelope)
        If Not spatialReferenceInfo Is Nothing Then
          adf_envelope.SpatialReference.CoordinateSystem = spatialReferenceInfo
        End If
        resultItem.RouteExtent = adf_envelope
        resultItem.RouteID = streetDirections.RouteID

        ' Get Directions
        Dim directions As DataTable = New DataTable("Directions")
        directions.Columns.Add("Step", GetType(String))
        directions.Columns.Add("Directions", GetType(String))
        directions.Columns.Add("Length", GetType(String))
        directions.Columns.Add("Summary", GetType(String))
        directions.Columns.Add("Time", GetType(String))
        directions.Columns.Add("Type", GetType(String))
                directions.Columns.Add("Cumulative Length", GetType(String))
                directions.Columns.Add("Street Name", GetType(String))
                directions.Columns.Add("Cross Street", GetType(String))
        'directions.Columns.Add("ETA", typeof(string));
        'directions.Columns.Add("Service Tim", typeof(string));
        'directions.Columns.Add("Time Window", typeof(string));
        'directions.Columns.Add("Violation Time", typeof(string));
        'directions.Columns.Add("Wait Time", typeof(string));

        resultItem.StepExtents = New ESRI.ArcGIS.ADF.Web.Geometry.Envelope(streetDirections.DirectionCount - 1) {}

        Dim j As Integer = 0
        Do While j < streetDirections.DirectionCount
          streetDirection = streetDirections.Direction(j)
          count = streetDirection.StringCount
          dataRow = directions.NewRow()
          directions.Rows.Add(dataRow)

          k = 0
          Do While k < count
            ' Get type of direction; column name
            stringType = streetDirection.StringType(k)
            columnName = GetDirectionsStringType(stringType)
            If ((stringType = esriDirectionsStringType.esriDSTArrive) Or (stringType = esriDirectionsStringType.esriDSTDepart)) Then
              directions.Rows(j)("Type") = columnName
              columnName = "Directions"
            ElseIf stringType = esriDirectionsStringType.esriDSTGeneral Then
              directions.Rows(j)("Type") = "General"
            End If

            ' Populate column
            directions.Rows(j)("Step") = j + 1
            columnValue = TryCast(directions.Rows(j)(columnName), String)
            If Not columnValue Is Nothing AndAlso columnValue.Length > 0 Then
              directions.Rows(j)(columnName) = columnValue & "<br>" & streetDirection.String(k)
            Else
              directions.Rows(j)(columnName) = streetDirection.String(k)
            End If
            k += 1
          Loop
          envelope = streetDirection.Envelope
          envelope.Expand(1.25, 1.25, True)
                    adf_envelope = ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer.Local.Converter.FromIEnvelope(envelope)
          If Not spatialReferenceInfo Is Nothing Then
            adf_envelope.SpatialReference.CoordinateSystem = spatialReferenceInfo
          End If
          resultItem.StepExtents(j) = adf_envelope
          j += 1
        Loop

        resultItem.Directions = directions
        resultItem.Summary = summary
        nasResultItems.Add(resultItem)
        i += 1
      Loop

      ' Assume only 1 route in the analysis problem so just return the directions for array[0]
      Return TryCast(nasResultItems(0), NetworkAnalystRouteResult)
    End Function


    ''' <summary>
    ''' Gets the column name for directions string type
    ''' </summary>
    ''' <param name="type">The type to get string for.</param>
    ''' <returns>The string for direction type.</returns>
    Public Shared Function GetDirectionsStringType(ByVal type As esriDirectionsStringType) As String
      Select Case type
        Case esriDirectionsStringType.esriDSTArrive
          Return "Arrive"
        Case esriDirectionsStringType.esriDSTDepart
          Return "Depart"
        Case esriDirectionsStringType.esriDSTGeneral
          Return "Directions"
        Case esriDirectionsStringType.esriDSTLength
          Return "Length"
        Case esriDirectionsStringType.esriDSTSummary
          Return "Summary"
        Case esriDirectionsStringType.esriDSTTime
          Return "Time"
        Case esriDirectionsStringType.esriDSTCumulativeLength
          Return "Cumulative Length"
        Case esriDirectionsStringType.esriDSTEstimatedArrivalTime
          Return "ETA"
        Case esriDirectionsStringType.esriDSTServiceTime
          Return "Service Time"
        Case esriDirectionsStringType.esriDSTTimeWindow
          Return "Time Window"
        Case esriDirectionsStringType.esriDSTViolationTime
          Return "Violation Time"
        Case esriDirectionsStringType.esriDSTWaitTime
                    Return "Wait Time"
                Case esriDirectionsStringType.esriDSTCrossStreet
                    Return "Cross Street"
                Case esriDirectionsStringType.esriDSTStreetName
                    Return "Street Name"
        Case Else
          Return "Default"
      End Select
    End Function

    ''' <summary>
    ''' Gets the layer using the layer id
    ''' </summary>
    ''' <param name="map">The map to which the layer belongs</param>
    ''' <param name="layerID">The id of the layer</param>
    ''' <returns>The layer at the id.</returns>
        Public Shared Function LayerFromLayerID(ByVal gisresource As MapResourceLocal, ByVal layerID As Integer) As ILayer

            Dim mapContext As IServerContext = gisresource.ServerContextInfo.ServerContext
            Dim mso As IMapServerObjects = CType(gisresource.MapServer, IMapServerObjects)
            Dim map As IMap = mso.Map(gisresource.DataFrame)

            Dim uidINALayer As UID = CType(mapContext.CreateObject("esriSystem.UID"), UID)
            uidINALayer.Value = "{667B776B-5905-4450-9C94-18B214ECE8FB}"

            Dim elayers As IEnumLayer = map.Layers(uidINALayer, True)
            Dim elayer As ILayer = elayers.Next()
            Dim i As Integer = 0
            Do While Not elayer Is Nothing
                If i = layerID Then
                    Return elayer
                End If
                i += 1
                elayer = elayers.Next()
            Loop
            Return Nothing
        End Function
  End Class
End Namespace