ArcGIS_NAServer_Routing_VBNet\Default.aspx.vb
' Copyright 2011 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.Data Imports System.Configuration Imports System.Collections Imports System.Collections.Specialized Imports System.Web Imports System.Web.Security Imports System.Web.UI Imports System.Web.UI.WebControls Imports System.Web.UI.WebControls.WebParts Imports System.Web.UI.HtmlControls Imports ESRI.ArcGIS.ADF.ArcGISServer Imports ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer Partial Public Class _Default Inherits System.Web.UI.Page ' Member Variables Private Const SERVER_NAME As String = "localhost" Private Const ROUTE_SERVICE_NAME As String = "SanFrancisco" Private Const LOCATOR_SERVICE_NAME As String = "SanFranciscoLocator" Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs) Page.Title = "Simple Routing Application" End Sub Protected Sub btnGetDirections_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnGetDirections.Click Solve() End Sub ''' <summary> ''' This function ''' - sets the server and solver parameters ''' - populates the stops NALocations ''' - gets and displays the server results (map, directions) ''' </summary> Private Sub Solve() Try ' Get the NAServer Using naServer As NAServerProxy = NAServerProxy.Create(SERVER_NAME, ROUTE_SERVICE_NAME, Nothing) If naServer Is Nothing Then Throw (New System.Exception("Could not find the web service.")) End If ' Get the NAServerSolverParams Dim naLayers As String() = naServer.GetNALayerNames(esriNAServerLayerType.esriNAServerRouteLayer) Dim solverParams As NAServerSolverParams = TryCast(naServer.GetSolverParameters(naLayers(0)), NAServerSolverParams) ' Set the NAServerRouteParams Dim routeParams As NAServerRouteParams = TryCast(solverParams, NAServerRouteParams) Dim time As DateTime routeParams.UseStartTime = DateTime.TryParse(txtStartTime.Value, time) If routeParams.UseStartTime Then routeParams.StartTime = time End If routeParams.ReturnMap = False routeParams.ReturnRouteGeometries = True routeParams.ReturnStops = True routeParams.ReturnDirections = chkShowDirections.Checked routeParams.DirectionsTimeAttributeName = "Minutes" routeParams.ImpedanceAttributeName = "Minutes" ' Set Output Spatial Reference Dim mapFunctionality As MapFunctionality = CType(Map1.GetFunctionality(0), MapFunctionality) routeParams.OutputSpatialReference = mapFunctionality.MapDescription.SpatialReference ' Geocode two addresses and create the stop network locations LoadLocations(solverParams) ' Solve the Route Dim solverResults As NAServerSolverResults solverResults = naServer.Solve(solverParams) ' Display results OutputResults(solverResults) End Using Catch exception As Exception pnlDirectionSummary.Visible = False lblDirections.Visible = False lblTotalDistance.Visible = False dataGridDirections.Visible = False lblError.Text = "An error has occurred Mesage = " & exception.Message End Try End Sub ''' <summary> ''' This function shows how to populate stop locations using an array of PropertySets ''' </summary> Private Sub LoadLocations(ByVal solverParams As NAServerSolverParams) ' Geocode Addresses Dim propSets As PropertySet() = New PropertySet(1) {} propSets(0) = GeocodeAddress(txtFromStreet.Value, txtFromCity.Value, txtFromState.Value, txtFromZip.Value) propSets(1) = GeocodeAddress(txtToStreet.Value, txtToCity.Value, txtToState.Value, txtToZip.Value) Dim StopsPropSets As NAServerPropertySets = New NAServerPropertySets() StopsPropSets.PropertySets = propSets Dim routeParams As NAServerRouteParams = TryCast(solverParams, NAServerRouteParams) routeParams.Stops = StopsPropSets End Sub ''' <summary> ''' Geocode an address based on the street name, city, state, and zip code ''' Throws and exception and returns null if the address was unmatched. ''' </summary> Private Function GeocodeAddress(ByVal streetAddress As String, ByVal city As String, ByVal state As String, ByVal zipCode As String) As PropertySet Dim propSet As PropertySet = Nothing Try Using gc As GeocodeServerProxy = GeocodeServerProxy.Create(SERVER_NAME, LOCATOR_SERVICE_NAME, Nothing) Dim addressProperties As PropertySet = New PropertySet() Dim addressFields As Fields Dim field As Field Dim propSetProperty As PropertySetProperty() = New PropertySetProperty(3) {} addressFields = gc.GetAddressFields() Dim i As Integer = 0 Do While i < addressFields.FieldArray.GetLength(0) field = addressFields.FieldArray(i) If field.Name.Equals("STREET", StringComparison.OrdinalIgnoreCase) Then propSetProperty(0) = TryCast(CreatePropertySetProperty(field.AliasName, streetAddress), PropertySetProperty) End If If field.Name.Equals("CITY", StringComparison.OrdinalIgnoreCase) Then propSetProperty(1) = TryCast(CreatePropertySetProperty(field.AliasName, city), PropertySetProperty) End If If field.Name.Equals("STATE", StringComparison.OrdinalIgnoreCase) Then propSetProperty(2) = TryCast(CreatePropertySetProperty(field.AliasName, state), PropertySetProperty) End If If field.Name.Equals("ZIP", StringComparison.OrdinalIgnoreCase) OrElse field.Name.Equals("ZONE", StringComparison.OrdinalIgnoreCase) Then propSetProperty(3) = TryCast(CreatePropertySetProperty(field.AliasName, zipCode), PropertySetProperty) End If i += 1 Loop addressProperties.PropertyArray = propSetProperty ' find the matching address propSet = gc.GeocodeAddress(addressProperties, Nothing) End Using Catch exception As Exception lblError.Text = "An error has occurred Mesage = " & exception.Message End Try ' Throw and error if the geocoded address is "Unmatched" If (Not propSet Is Nothing) AndAlso (propSet.PropertyArray(1).Value.ToString() = "U") Then Throw (New System.Exception("Could not geocode [" & streetAddress & "]")) End If ' Overwrite the "matched" property with the "Name" of the street propSet.PropertyArray(1).Key = "Name" propSet.PropertyArray(1).Value = streetAddress Return propSet End Function ''' <summary> ''' CreatePropertySetProperty ''' </summary> Private Function CreatePropertySetProperty(ByVal key As String, ByVal value As Object) As PropertySetProperty Dim propSetProperty As PropertySetProperty = New PropertySetProperty() propSetProperty.Key = key propSetProperty.Value = value Return propSetProperty End Function ''' <summary> ''' Output Results map, Directions ''' </summary> Private Sub OutputResults(ByVal solverResults As NAServerSolverResults) Dim messagesSolverResults As String = "" ' Output Solve messages Dim gpMessages As GPMessages = solverResults.SolveMessages Dim arrGPMessage As GPMessage() = gpMessages.GPMessages1 If Not arrGPMessage Is Nothing Then Dim i As Integer = 0 Do While i < arrGPMessage.GetLength(0) Dim gpMessage As GPMessage = arrGPMessage(i) messagesSolverResults &= Constants.vbLf + gpMessage.MessageDesc i += 1 Loop End If lblError.Text = messagesSolverResults Dim RouteSolverResults As NAServerRouteResults = TryCast(solverResults, NAServerRouteResults) ' Display turn-by-turn directions If chkShowDirections.Checked = True Then OutputDirections(RouteSolverResults.Directions) Else ' Or simply display the total impedance for the route lblTotalTime.Text = "Total Time: " & RouteSolverResults.TotalImpedances(0).ToString("F") & " mn" lblTotalDistance.Visible = False pnlDirectionSummary.Visible = True lblDirections.Visible = False dataGridDirections.Visible = False End If ' Add graphics from route and stops Dim graphicElements As GraphicElement() = New GraphicElement(RouteSolverResults.RouteGeometries.Length + RouteSolverResults.Stops.Records.Length - 1) {} AddRoutesToGraphicElements(RouteSolverResults.RouteGeometries, graphicElements) AddStopsToGraphicElements(RouteSolverResults.Stops, graphicElements) Dim mapFunctionality As MapFunctionality = CType(Map1.GetFunctionality(0), MapFunctionality) mapFunctionality.MapDescription.CustomGraphics = graphicElements ' Zoom to extent Dim polylineN As PolylineN = TryCast(RouteSolverResults.RouteGeometries(0), PolylineN) Dim envelopeN As EnvelopeN = TryCast(polylineN.Extent, EnvelopeN) Dim width As Double = envelopeN.XMax - envelopeN.XMin Dim height As Double = envelopeN.YMax - envelopeN.YMin Dim fivePercent As Double If width > height Then fivePercent = width * 0.05 Else fivePercent = height * 0.05 End If envelopeN.XMin = envelopeN.XMin - fivePercent envelopeN.YMin = envelopeN.YMin - fivePercent envelopeN.XMax = envelopeN.XMax + fivePercent envelopeN.YMax = envelopeN.YMax + fivePercent Map1.Extent = ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer.Converter.ToAdfEnvelope(envelopeN) Map1.Refresh() End Sub ' Add routes as blue lines Public Sub AddRoutesToGraphicElements(ByVal polylines As Polyline(), ByVal graphicElements As GraphicElement()) Dim rgb As RgbColor = New RgbColor() rgb.Red = 0 rgb.Green = 0 rgb.Blue = 255 rgb.AlphaValue = 32 Dim sls As SimpleLineSymbol = New SimpleLineSymbol() sls.Color = rgb sls.Style = esriSimpleLineStyle.esriSLSSolid sls.Width = 6 Dim i As Integer = 0 Do While i < polylines.Length Dim le As LineElement = New LineElement() le.Line = polylines(i) le.Symbol = sls graphicElements(i) = le i += 1 Loop End Sub ' Add all stops as black circles Public Sub AddStopsToGraphicElements(ByVal stops As RecordSet, ByVal graphicElements As GraphicElement()) Dim stopRecords As Record() = stops.Records Dim stopCount As Integer = stopRecords.Length Dim rgb As RgbColor = New RgbColor() rgb.Red = 0 rgb.Green = 0 rgb.Blue = 0 rgb.AlphaValue = 255 Dim sms As SimpleMarkerSymbol = New SimpleMarkerSymbol() sms.Color = rgb sms.Style = esriSimpleMarkerStyle.esriSMSCircle sms.Size = 16 Dim iGraphicElement As Integer = graphicElements.Length - stopCount Dim iStop As Integer = 0 Do While iStop < stopCount Dim [me] As MarkerElement = New MarkerElement() [me].Point = TryCast(stopRecords(iStop).Values(1), PointN) [me].Symbol = sms graphicElements(iGraphicElement) = [me] iGraphicElement += 1 iStop += 1 Loop End Sub ''' <summary> ''' Output Directions if a dataGrid control ''' </summary> Private Sub OutputDirections(ByVal serverDirections As NAStreetDirections()) If serverDirections Is Nothing Then Return End If ' get Directions from the ith route Dim directions As NAStreetDirections directions = serverDirections(0) ' get Summary (Total Distance and Time) Dim direction As NAStreetDirection = directions.Summary Dim totallength As String = Nothing, totaltime As String = Nothing Dim SummaryStrings As String() = direction.Strings Dim k As Integer = SummaryStrings.GetLowerBound(0) Do While k < SummaryStrings.GetUpperBound(0) If direction.StringTypes(k) = esriDirectionsStringType.esriDSTLength Then totallength = SummaryStrings(k) End If If direction.StringTypes(k) = esriDirectionsStringType.esriDSTTime Then totaltime = SummaryStrings(k) End If k += 1 Loop ' Display the direction in a DataGrid Dim dataSet As DataSet = New DataSet("dataSet") Dim dataTable As DataTable = New DataTable("Results") dataSet.Tables.Add(dataTable) Dim dataColumn As DataColumn = Nothing dataColumn = New DataColumn("Step ") dataTable.Columns.Add(dataColumn) dataColumn = New DataColumn("Directions ") dataTable.Columns.Add(dataColumn) dataColumn = New DataColumn("Estimated Arrival Time ") dataTable.Columns.Add(dataColumn) ' Then add a node for each step-by-step directions Dim newDataRow As DataRow Dim StreetDirections As NAStreetDirection() = directions.Directions Dim directionIndex As Integer = StreetDirections.GetLowerBound(0) Do While directionIndex <= StreetDirections.GetUpperBound(0) Dim streetDirection As NAStreetDirection = StreetDirections(directionIndex) Dim StringStreetDirection As String() = streetDirection.Strings newDataRow = dataTable.NewRow() newDataRow(0) = System.Convert.ToString(directionIndex + 1) Dim stringIndex As Integer = StringStreetDirection.GetLowerBound(0) Do While stringIndex <= StringStreetDirection.GetUpperBound(0) If streetDirection.StringTypes(stringIndex) = esriDirectionsStringType.esriDSTGeneral OrElse streetDirection.StringTypes(stringIndex) = esriDirectionsStringType.esriDSTDepart OrElse streetDirection.StringTypes(stringIndex) = esriDirectionsStringType.esriDSTArrive Then newDataRow(1) = StringStreetDirection(stringIndex) End If If streetDirection.StringTypes(stringIndex) = esriDirectionsStringType.esriDSTEstimatedArrivalTime Then newDataRow(2) = StringStreetDirection(stringIndex) End If stringIndex += 1 Loop dataTable.Rows.Add(newDataRow) directionIndex += 1 Loop dataGridDirections.DataSource = dataSet dataGridDirections.DataBind() dataGridDirections.Visible = True ' Display Total Distance and Total Time lblTotalDistance.Text = "Total Distance: " & totallength lblTotalTime.Text = "Total Time: " & totaltime pnlDirectionSummary.Visible = True lblDirections.Visible = True lblTotalDistance.Visible = True End Sub End Class