Network Analyst routing
ArcGIS_Routing_VBNet\Directions.aspx.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 System.Collections
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Xml
Imports System.Web
Imports System.Web.SessionState
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.HtmlControls
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Location
Imports ESRI.ArcGIS.Server
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.NetworkAnalyst
Imports ESRI.ArcGIS.Server.Web.NetworkAnalyst
Imports System.Collections.Specialized
Imports ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer

Namespace RouteFinder
  ''' <summary>
  ''' Summary description for Directions.
  ''' </summary>
  Public Partial Class Directions
    Inherits System.Web.UI.Page
    Implements RouteFinder.IBaseRouteFinderPage
    Private serverObjectStateModifier As ServerObjectStateModifier = Nothing

    Public Sub Page_PreInit(ByVal sender As Object, ByVal e As EventArgs)
      serverObjectStateModifier = New ServerObjectStateModifier()
    End Sub

    Protected Sub Page_Init(ByVal sender As Object, ByVal e As EventArgs)
      AddHandler Map1.Load, AddressOf Map1_Load

    End Sub

    Private Sub Map1_Load(ByVal sender As Object, ByVal e As EventArgs)
      If Page.IsPostBack Then
        If (Not MapResourceManager1.Initialized) Then
          MapResourceManager1.Initialize()
        End If
      End If
    End Sub

    Protected Sub Page_PreRender(ByVal sender As Object, ByVal e As System.EventArgs)
      If (Not Page.IsPostBack) Then
'        #Region "Get XY and Address parameters"

        Dim fromAddress As String = Convert.ToString(Session("FromAddress"))
        Dim toAddress As String = Convert.ToString(Session("ToAddress"))
        Dim fromX As Double = Convert.ToDouble(Page.Request.Params("FromX"))
        Dim fromY As Double = Convert.ToDouble(Page.Request.Params("FromY"))
        Dim toX As Double = Convert.ToDouble(Page.Request.Params("ToX"))
        Dim toY As Double = Convert.ToDouble(Page.Request.Params("ToY"))
'        #End Region

'        #Region "Get Route between Addresses"

        If fromX = 0.0 AndAlso toX = 0.0 Then
          Return
        End If

        Dim result As NetworkAnalystRouteResult = SolveRoute(fromX, fromY, toX, toY, fromAddress, toAddress)
        DisplayDirections(result, fromAddress, toAddress)
'        #End Region
      End If
    End Sub

    ''' <summary>
    ''' Solves route between two geocoded locations
    ''' </summary>
        Public Function SolveRoute(ByVal fromX As Double, ByVal fromY As Double, ByVal toX As Double, ByVal toY As Double, ByVal fromAddress As String, ByVal toAddress As String) As NetworkAnalystRouteResult Implements IBaseRouteFinderPage.SolveRoute

            '      #Region "Get a reference to the Map"
            If (Not MapResourceManager1.Initialized) Then
                MapResourceManager1.Initialize()
            End If

            Dim mapResourceLocal As MapResourceLocal = CType(MapResourceManager1.GetResource(0), MapResourceLocal)
            Dim serverContext As IServerContext = mapResourceLocal.ServerContextInfo.ServerContext
            Dim mapServerObjects As IMapServerObjects = CType(mapResourceLocal.MapServer, IMapServerObjects)
            Dim map As IMap = mapServerObjects.Map(mapResourceLocal.DataFrame)
            '      #End Region


            '      #Region "Get first Route Layer"

            Dim naLayer As INALayer2 = Nothing
            Dim layerID As Integer = -1

            Dim uidINALayer As UID = CType(serverContext.CreateObject("esriSystem.UID"), UID)
            uidINALayer.Value = "{667B776B-5905-4450-9C94-18B214ECE8FB}"
            Dim elayers As IEnumLayer = map.Layers(uidINALayer, True)
            Dim layer As ILayer = elayers.Next()
            Dim i As Integer = 0
            Do While Not layer Is Nothing
                If (TypeOf layer Is INALayer) AndAlso (layer.Name = "Route") Then
                    naLayer = TryCast(layer, INALayer2)
                    layerID = i
                    Exit Do
                End If
                i += 1
                layer = elayers.Next()
            Loop

            If layerID = -1 Then
                Throw New Exception("No Route layers in map")
            End If

            Session("RouteLayerID") = layerID
            '      #End Region


            '      #Region "Get a copy of the original NAContext to restore at the end of the request"

            ' Only save the original context once
            Dim originalContextSerialized As String = TryCast(Session("OriginalNAContext"), String)
            If originalContextSerialized Is Nothing Then
                Dim originalNAContext As INAContext = naLayer.CopyContext()
                originalContextSerialized = serverContext.SaveObject(originalNAContext)
                Session("OriginalNAContext") = originalContextSerialized
            End If

            Dim naContext As INAContext = naLayer.Context
            '      #End Region


            '      #Region "Add From and To Points"

            'delete any old stops
            Dim naClass As INAClass = TryCast(naContext.NAClasses.ItemByName("Stops"), INAClass)
            naClass.DeleteAllRows()

            'add from point
            Dim point As IPoint = TryCast(serverContext.CreateObject("esriGeometry.Point"), IPoint)

            point.PutCoords(fromX, fromY)

            NetworkAnalystUtility.AddLocation(naContext, "Stops", point, fromAddress, 100)
            'add to point
            point.PutCoords(toX, toY)
            NetworkAnalystUtility.AddLocation(naContext, "Stops", point, toAddress, 100)

            ' Message all of the network analysis agents that the analysis context has changed
            CType(naContext, INAContextEdit).ContextChanged()
            '      #End Region


            '      #Region "Solve and Display Route"

            ' Solve the route and generated the resulting directions
            Dim gpMessages As IGPMessages = TryCast(serverContext.CreateObject("esriGeodatabase.GPMessages"), IGPMessages)
            Dim solver As INASolver = naContext.Solver
            solver.Solve(naContext, gpMessages, Nothing)

            Dim result As NetworkAnalystRouteResult = NetworkAnalystUtility.GetDirections(naContext, "Routes", serverContext)

            'Draw the map centered on route
            Map1.Extent = result.RouteExtent

            '      #End Region


            '      #Region "Store Extents in Session for Use in Zooming to Full Extent or to Each Step"

            Session("PathExtent") = result.RouteExtent
            Session("DirectionExtents") = result.StepExtents
            '      #End Region


            '      #Region "Store coords for ReverseDirections"

            Session("FromX") = fromX
            Session("FromY") = fromY
            Session("ToX") = toX
            Session("ToY") = toY
            Session("FromAddress") = fromAddress
            Session("ToAddress") = toAddress
            '      #End Region

            Session("ModifiedNAContextApplied") = True

            Return result
        End Function
    ''' <summary>
    ''' Populates datagrid with directions and javascript array with summary
    ''' </summary>
        Public Sub DisplayDirections(ByVal result As NetworkAnalystRouteResult, ByVal fromAdd As String, ByVal toAdd As String) Implements IBaseRouteFinderPage.DisplayDirections
            '      #Region "Write Summary"

            Dim sb As System.Text.StringBuilder = New System.Text.StringBuilder()
            sb.Append("<b>Starting from:</b> " & fromAdd & "<br>")
            sb.Append("<b>Arriving at:</b> " & toAdd & "<br>")
            sb.Append("<b>Distance: </b> " & result.Summary("Length") & "<br>")
            sb.Append("<b>Time: </b> " & result.Summary("Time") & "<br>")
            DirectionsSummary.InnerHtml = sb.ToString()
            Session("Summary") = DirectionsSummary.InnerHtml

            '      #End Region

            '      #Region "Populate data grid"

            DataGrid1.DataSource = Nothing

            'Get data table and remove unnecessary columns
            Dim dataTable As DataTable = result.Directions
            dataTable.Columns.Remove("Summary") 'this column displays the same information found in the columns that follow it
            dataTable.Columns.Remove("Type")
            '      #Region "Create Links in Table for Zooming In to Each Step"
            '      #Region "Merge 1st and 2nd rows"
            dataTable.Rows(1)("Directions") = String.Format("{0}. {1}", dataTable.Rows(0)("Directions"), dataTable.Rows(1)("Directions"))
            dataTable.Rows(dataTable.Rows.Count - 2)("Directions") = String.Format("{0}. {1}", dataTable.Rows(dataTable.Rows.Count - 2)("Directions"), dataTable.Rows(dataTable.Rows.Count - 1)("Directions"))
            dataTable.Rows.RemoveAt(dataTable.Rows.Count - 1)
            dataTable.Rows.RemoveAt(0)
            '      #End Region

            '      #Region "Create Links"
            Dim dataRow As DataRow
            Dim i As Integer = 0
            Do While i < dataTable.Rows.Count
                dataRow = dataTable.Rows(i)
                Dim [step] As String = Convert.ToString((i + 1)) 'add 1 because 1st row was merged into the second
                'Link Directions
                dataRow("Directions") = "<a href=""javascript:ZoomTo(" & [step] & ")"">" & dataRow("Directions") & "</a>"
                'Link Step
                dataRow("Step") = "<b><a href=""javascript:ZoomTo(" & [step] & ")"">" & [step] & "</a></b>"
                i += 1
            Loop
            '      #End Region

            ' bind new datatable to datagrid
            DataGrid1.DataSource = dataTable
            DataGrid1.DataBind()
            '      #End Region
            ' save to session for print page
            Session("Directions_DataTable") = dataTable

            Return

            '      #End Region
        End Sub

    Protected Sub MapResourceManager1_ResourcesDispose(ByVal sender As Object, ByVal e As EventArgs)
      If CBool(Session("ModifiedNAContextApplied")) Then
         Dim mapresourceitem As ESRI.ArcGIS.ADF.Web.UI.WebControls.MapResourceItem = MapResourceManager1.ResourceItems.Find("MapResourceItem0")
         If Not mapresourceitem Is Nothing Then
           serverObjectStateModifier.ApplyOriginalNAContext(mapresourceitem)
           Session("ModifiedNAContextApplied") = False
         End If
      End If
    End Sub

    Protected Sub MapResourceManager1_ResourceInit(ByVal sender As Object, ByVal e As EventArgs)
      Dim riea As ESRI.ArcGIS.ADF.Web.UI.WebControls.ResourceInitEventArgs = TryCast(e, ESRI.ArcGIS.ADF.Web.UI.WebControls.ResourceInitEventArgs)

      If riea.GISResourceItem.Name = "MapResourceItem0" Then
        CustomResourceInit(riea.GISResourceItem)
      End If
    End Sub

    Protected Sub CustomResourceInit(ByVal resource As ESRI.ArcGIS.ADF.Web.UI.WebControls.GISResourceItem)
      Dim modifiedNAContextApplied As Object = System.Web.HttpContext.Current.Session("ModifiedNAContextApplied")
      If modifiedNAContextApplied Is Nothing OrElse (Not CBool(modifiedNAContextApplied)) Then
        serverObjectStateModifier.ApplySessionNAContext(resource)
        System.Web.HttpContext.Current.Session("ModifiedNAContextApplied") = True
      End If
    End Sub


    #Region "Error Functions"
    Protected Sub Directions_Error(ByVal sender As Object, ByVal e As EventArgs)
      Dim exception As Exception = Server.GetLastError()
      Server.ClearError()
      callErrorPage("Page_Error", exception)
    End Sub

    ''' <summary>
    ''' Displays the error page.
    ''' </summary>
    Private Sub callErrorPage(ByVal errorMessage As String, ByVal exception As Exception)
      Session("ErrorMessage") = errorMessage
      Session("Error") = exception
      Page.Response.Redirect("ErrorPage.aspx", True)
    End Sub
    #End Region


  End Class
End Namespace