1
2' Copyright 1995-2005 ESRI
3
4' All rights reserved under the copyright laws of the United States.
5
6' You may freely redistribute and use this sample code, with or without modification.
7
8' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED
9' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
10' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR
11' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
12' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
13' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
14' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY
15' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY
16' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF
17' SUCH DAMAGE.
18
19' For additional information contact: Environmental Systems Research Institute, Inc.
20
21' Attn: Contracts Dept.
22
23' 380 New York Street
24
25' Redlands, California, U.S.A. 92373
26
27' Email: contracts@esri.com
28
29Option Explicit
30
31' vb version of the PathFinder object
32
33' 本地变量
34Private m_ipGeometricNetwork As esriGeoDatabase.IGeometricNetwork
35Private m_ipMap As esriCarto.IMap
36Private m_ipPoints As esriGeometry.IPointCollection
37Private m_ipPointToEID As esriNetworkAnalysis.IPointToEID
38' 返回结果变量
39Private m_dblPathCost As Double
40Private m_ipEnumNetEID_Junctions As esriGeoDatabase.IEnumNetEID
41Private m_ipEnumNetEID_Edges As esriGeoDatabase.IEnumNetEID
42Private m_ipPolyline As esriGeometry.IPolyline
43
44
45' Optionally set the Map (e.g. the current map in ArcMap),
46' otherwise a default map will be made (for IPointToEID).
47
48Public Property Set Map(Map As esriCarto.IMap)
49 Set m_ipMap = Map
50End Property
51
52Public Property Get Map() As esriCarto.IMap
53 Set Map = m_ipMap
54End Property
55
56' Either OpenAccessNetwork or OpenFeatureDatasetNetwork
57' needs to be called.
58
59Public Sub OpenAccessNetwork(AccessFileName As String, FeatureDatasetName As String)
60
61 Dim ipWorkspaceFactory As esriGeoDatabase.IWorkspaceFactory
62 Dim ipWorkspace As esriGeoDatabase.IWorkspace
63 Dim ipFeatureWorkspace As esriGeoDatabase.IFeatureWorkspace
64 Dim ipFeatureDataset As esriGeoDatabase.IFeatureDataset
65
66 ' After this Sub exits, we'll have an INetwork interface
67 ' and an IMap interface initialized for the network we'll be using.
68
69 ' close down the last one if opened
70 CloseWorkspace
71
72 ' open the mdb
73 Set ipWorkspaceFactory = New esriDataSourcesGDB.AccessWorkspaceFactory
74 Set ipWorkspace = ipWorkspaceFactory.OpenFromFile(AccessFileName, 0)
75
76 ' get the FeatureWorkspace
77 Set ipFeatureWorkspace = ipWorkspace
78
79 ' open the FeatureDataset
80 Set ipFeatureDataset = ipFeatureWorkspace.OpenFeatureDataset(FeatureDatasetName)
81
82 ' initialize Network and Map (m_ipNetwork, m_ipMap)
83 If Not InitializeNetworkAndMap(ipFeatureDataset) Then Err.Raise 0, "OpenAccessNetwork", "Error initializing Network and Map"
84
85End Sub
86
87Public Sub OpenFeatureDatasetNetwork(FeatureDataset As esriGeoDatabase.IFeatureDataset)
88 ' close down the last one if opened
89 CloseWorkspace
90
91 ' we assume that the caller has passed a valid FeatureDataset
92
93 ' initialize Network and Map (m_ipNetwork, m_ipMap)
94 If Not InitializeNetworkAndMap(FeatureDataset) Then Err.Raise 0, "OpenFeatureDatasetNetwork", "Error initializing Network and Map"
95
96End Sub
97
98' The collection of points to travel through must be set.
99
100Public Property Set StopPoints(Points As esriGeometry.IPointCollection)
101 Set m_ipPoints = Points
102End Property
103
104Public Property Get StopPoints() As esriGeometry.IPointCollection
105 Set StopPoints = m_ipPoints
106End Property
107
108' Calculate the path
109
110Public Sub SolvePath(WeightName As String)
111
112 Dim ipNetwork As esriGeoDatabase.INetwork
113 Dim ipTraceFlowSolver As esriNetworkAnalysis.ITraceFlowSolver
114 Dim ipNetSolver As esriNetworkAnalysis.INetSolver
115 Dim ipNetFlag As esriNetworkAnalysis.INetFlag
116 Dim ipaNetFlag() As esriNetworkAnalysis.IEdgeFlag
117 Dim ipEdgePoint As esriGeometry.IPoint
118 Dim ipNetElements As esriGeoDatabase.INetElements
119 Dim intEdgeUserClassID As Long
120 Dim intEdgeUserID As Long
121 Dim intEdgeUserSubID As Long
122 Dim intEdgeID As Long
123 Dim ipFoundEdgePoint As esriGeometry.IPoint
124 Dim dblEdgePercent As Double
125 Dim ipNetWeight As esriGeoDatabase.INetWeight
126 Dim ipNetSolverWeights As esriNetworkAnalysis.INetSolverWeights
127 Dim ipNetSchema As esriGeoDatabase.INetSchema
128 Dim intCount As Long
129 Dim i As Long
130 Dim vaRes() As Variant
131
132 ' make sure we are ready
133 Debug.Assert Not m_ipPoints Is Nothing
134 Debug.Assert Not m_ipGeometricNetwork Is Nothing
135
136 ' instantiate a trace flow solver
137 Set ipTraceFlowSolver = New esriNetworkAnalysis.TraceFlowSolver
138
139 ' get the INetSolver interface
140 Set ipNetSolver = ipTraceFlowSolver
141
142 ' set the source network to solve on
143 Set ipNetwork = m_ipGeometricNetwork.Network
144 Set ipNetSolver.SourceNetwork = ipNetwork
145
146 ' make edge flags from the points
147
148 ' the INetElements interface is needed to get UserID, UserClassID,
149 ' and UserSubID from an element id
150 Set ipNetElements = ipNetwork
责任编辑：小草
