MsgBox("6 " + startpoint.X.ToString) routeClass.Init() route1 = routeClass.SolveRoute() If Not route1 Is Nothing Then startOID = OutputDatabase1.WriteToRouteTableRowField(person_number, route1) route1length = route1.Length MsgBox("99" + route1length.ToString) Else route1length = 0 End If crowflies = crowFliesDistance(startpoint, endpoint) MsgBox("22" + crowflies.ToString) End If End If
Public Class RouteClass Public Const SHAPE_WORKSPACE As String = "C:\Users\Paul\Downloads\Geo\" Private Const INPUT_STOPS_FC As String = "StopsInput" Private Const SHAPE_INPUT_NAME_FIELD As String = "StopsInput" Private Const NETWORK_DATASET As String = "DTO_Network_ND" 'Public naLayerStore As INALayer Dim workspaceFactory As IWorkspaceFactory = New ShapefileWorkspaceFactoryClass() Dim featureWorkspace As IFeatureWorkspace = workspaceFactory.OpenFromFile(SHAPE_WORKSPACE, 0) Dim pUID As UID = New UIDClass() Dim networkDataset As INetworkDataset Dim inputStopsFClass As IFeatureClass Dim NALayer As INALayer Dim naContext As INAContext Dim stopsNAClass As INAClass Dim routesFC As IFeatureClass Dim naClassFieldMap As INAClassFieldMap Dim naLoader As INAClassLoader Dim blankstops As Object Dim messages As New GPMessagesClass() Dim naSolver As INASolver Public Sub Init() pUID.Value = "esriGeoDatabase.NetworkDatasetWorkspaceExtension" Dim workspaceExtensionManager As IWorkspaceExtensionManager = featureWorkspace Dim datasetContainer2 As IDatasetContainer2 = workspaceExtensionManager.FindExtension(pUID) networkDataset = datasetContainer2.DatasetByName(esriDatasetType.esriDTNetworkDataset, NETWORK_DATASET) End Sub 'Create the analysis layer, load the locations, solve the analysis, and write to disk Public Function SolveRoute() As Integer() ' Open the feature workspace, input feature class, and network dataset inputStopsFClass = featureWorkspace.OpenFeatureClass(INPUT_STOPS_FC) ' Create the Route NALayer NALayer = CreateRouteAnalysisLayer("Route", networkDataset) naContext = NALayer.Context stopsNAClass = naContext.NAClasses.ItemByName("Stops") routesFC = naContext.NAClasses.ItemByName("Routes") ' Load the Stops naClassFieldMap = New NAClassFieldMapClass() naClassFieldMap.MappedField("Name") = SHAPE_INPUT_NAME_FIELD naLoader = New NAClassLoaderClass() naLoader.Locator = naContext.Locator naLoader.NAClass = stopsNAClass naLoader.FieldMap = naClassFieldMap naLoader.Load(inputStopsFClass.Search(Nothing, True), New CancelTrackerClass(), 0, 0) 'New QueryFilterClass() ' Message all of the network analysis agents that the analysis context has changed 'Dim naContextEdit As INAContextEdit = naContext 'naContextEdit.ContextChanged() 'Solve messages = New GPMessagesClass() Try naSolver = naContext.Solver naSolver.Solve(naContext, messages, New CancelTrackerClass()) Catch e As Exception TextFromFile1.errorwriter("Solver exception: " + e.Message, MakeRoute.person_no_global) If Not messages.Description Is Nothing Then TextFromFile1.errorwriter("Solver error: " + messages.Description, MakeRoute.person_no_global) Else TextFromFile1.errorwriter("Solver error: ", MakeRoute.person_no_global) End If Return Nothing End Try 'Save the layer to disk (disabled to improve execution speed 'SaveLayerToDisk(NALayer, System.Environment.CurrentDirectory + "\RouteGEN.lyr") 'naLayerStore = naLayer 'AREA FOR EXTRACTING THE FEATURES TRAVERSED BY THE ROUTE Dim naTraversalResult As INATraversalResult = CType(naLayer.Context.Result, INATraversalResult) Dim naTraversalResultQuery As INATraversalResultQuery = CType(naTraversalResult, INATraversalResultQuery) Dim traversalFClass As IFeatureClass = naTraversalResultQuery.FeatureClass(esriNetworkElementType.esriNETEdge) Dim featureCursor1 As IFeatureCursor = traversalFClass.Search(Nothing, True) Dim feature As IFeature = featureCursor1.NextFeature() If feature Is Nothing Then MsgBox("no result found to be added to database") End If ' Loop through all the traversal result elements for that feature Dim routeNums() As Integer = {0} Dim i As Integer = 0 Dim totlength As Double = 0 Dim poly As IPolyline While Not feature Is Nothing poly = feature.Shape totlength += poly.Length 'This is the FID value of each feature ReDim Preserve routeNums(0 To i) routeNums(i) = feature.Value(3) 'MsgBox(feature.Value(0).ToString + " . " + feature.Value(1).ToString + " . " + feature.Value(2).ToString + " . " + feature.Value(3).ToString + " . " + feature.Value(4).ToString + " . ") feature = featureCursor1.NextFeature() i = i + 1 End While Marshal.FinalReleaseComObject(featureCursor1) MakeRoute.resultDistance = totlength Return routeNums End Function 'Create a new network anlaysis layer and set some solver settings Private Function CreateRouteAnalysisLayer(ByVal layerName As String, ByVal networkDataset As INetworkDataset) As INALayer Dim naRouteSolver As INARouteSolver = New NARouteSolverClass() Dim naSolverSettings As INASolverSettings = naRouteSolver Dim naSolver As INASolver = naRouteSolver 'Get the NetworkDataset's Data Element Dim datasetComponent As IDatasetComponent = networkDataset Dim deNetworkDataset As IDENetworkDataset = datasetComponent.DataElement 'Create the NAContext and bind to it Dim naContext As INAContext = naSolver.CreateContext(deNetworkDataset, layerName) Dim naContextEdit As INAContextEdit = naContext naContextEdit.Bind(networkDataset, New GPMessagesClass()) 'Create the NALayer Dim naLayer As INALayer = naSolver.CreateLayer(naContext) Dim layer As ILayer = naLayer layer.Name = layerName 'Set some properties on the the route solver interface naRouteSolver.FindBestSequence = True naRouteSolver.PreserveFirstStop = True naRouteSolver.PreserveLastStop = False naRouteSolver.UseTimeWindows = False naRouteSolver.OutputLines = esriNAOutputLineType.esriNAOutputLineTrueShapeWithMeasure 'Set some properties on the general INASolverSettings interface Dim restrictions As IStringArray = naSolverSettings.RestrictionAttributeNames 'Dim att As IStringArray = naSolverSettings.AccumulateAttributeNames 'att.Add("LEN_KM") 'naSolverSettings.AccumulateAttributeNames = att naSolverSettings.RestrictionAttributeNames = restrictions 'CODE TO USE HIERARCHY, or not naSolverSettings.UseHierarchy = MakeRoute.useHierarchy ' Update the context based on the changes made to the solver settings naSolver.UpdateContext(naContext, deNetworkDataset, New GPMessagesClass()) 'Return the layer Return naLayer End Function 'Write the NALayer out to disk as a layer file. Public Sub SaveLayerToDisk(ByVal layer As ILayer, ByVal path As String) Try Console.WriteLine("Writing layer file containing analysis to " + path) Dim layerfile As ILayerFile = New LayerFileClass() layerfile.New(path) layerfile.ReplaceContents(layer) layerfile.Save() Console.WriteLine("Writing layer file successfully saved") Catch err As Exception ' Write out errors Console.WriteLine(err.Message) TextFromFile1.errorwriter("save layer error: ", MakeRoute.person_no_global) End Try End Sub
Solved! Go to Solution.