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