ArcGIS网络分析最短路径分析源代码(VB6.0)
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
151
152 ' get the count
153 intCount = m_ipPoints.PointCount
154 Debug.Assert intCount > 1
155
156 ' dimension our IEdgeFlag array
157 ReDim ipaNetFlag(intCount)
158
159 For i = 0 To intCount - 1
160 ' make a new Edge Flag
161 Set ipNetFlag = New esriNetworkAnalysis.EdgeFlag
162 Set ipEdgePoint = m_ipPoints.Point(i)
163 ' look up the EID for the current point (this will populate intEdgeID and dblEdgePercent)
164 m_ipPointToEID.GetNearestEdge ipEdgePoint, intEdgeID, ipFoundEdgePoint, dblEdgePercent
165 Debug.Assert intEdgeID > 0 ' else Point (eid) not found
166 ipNetElements.QueryIDs intEdgeID, esriETEdge, intEdgeUserClassID, intEdgeUserID, intEdgeUserSubID
167 Debug.Assert (intEdgeUserClassID > 0) And (intEdgeUserID > 0) ' else Point not found
168 ipNetFlag.UserClassID = intEdgeUserClassID
169 ipNetFlag.UserID = intEdgeUserID
170 ipNetFlag.UserSubID = intEdgeUserSubID
171 Set ipaNetFlag(i) = ipNetFlag
172 Next
173
174 ' add these edge flags
175 ipTraceFlowSolver.PutEdgeOrigins intCount, ipaNetFlag(0)
176
177 ' set the weight (cost field) to solve on
178
179 ' get the INetSchema interface
180 Set ipNetSchema = ipNetwork
181 Set ipNetWeight = ipNetSchema.WeightByName(WeightName)
182 Debug.Assert Not ipNetWeight Is Nothing
183
184 ' set the weight (use the same for both directions)
185 Set ipNetSolverWeights = ipTraceFlowSolver
186 Set ipNetSolverWeights.FromToEdgeWeight = ipNetWeight
187 Set ipNetSolverWeights.ToFromEdgeWeight = ipNetWeight
188
189 ' initialize array for results to number of segments in result
190 ReDim vaRes(intCount - 1)
191
192 ' solve it
193 ipTraceFlowSolver.FindPath esriFMConnected, esriSPObjFnMinSum, m_ipEnumNetEID_Junctions, m_ipEnumNetEID_Edges, intCount - 1, vaRes(0)
194
195 ' compute total cost
196 m_dblPathCost = 0
197 For i = LBound(vaRes) To UBound(vaRes)
198 m_dblPathCost = m_dblPathCost + vaRes(i)
199 Next
200
201 ' clear the last polyline result
202 Set m_ipPolyline = Nothing
203
204End Sub
205
206' Property to get the cost
207
208Public Property Get PathCost() As Double
209 PathCost = m_dblPathCost
210End Property
211
212' Property to get the shape
213
214Public Property Get PathPolyLine() As esriGeometry.IPolyline
215
216 Dim ipEIDHelper As esriNetworkAnalysis.IEIDHelper
217 Dim count As Long, i As Long
218 Dim ipEIDInfo As esriNetworkAnalysis.IEIDInfo
219 Dim ipEnumEIDInfo As esriNetworkAnalysis.IEnumEIDInfo
220 Dim ipGeometry As esriGeometry.IGeometry
221 Dim ipNewGeometryColl As esriGeometry.IGeometryCollection
222 Dim ipSpatialReference As esriGeometry.ISpatialReference
223
224 ' if the line is already computed since the last path, just return it
225 If Not m_ipPolyline Is Nothing Then
226 Set PathPolyLine = m_ipPolyline
227 Exit Property
228 End If
229
230 Set m_ipPolyline = New esriGeometry.Polyline
231 Set ipNewGeometryColl = m_ipPolyline
232
233 ' a path should be solved first
234 Debug.Assert Not m_ipEnumNetEID_Edges Is Nothing
235
236 ' make an EIDHelper object to translate edges to geometric features
237 Set ipEIDHelper = New esriNetworkAnalysis.EIDHelper
238 Set ipEIDHelper.GeometricNetwork = m_ipGeometricNetwork
239 Set ipSpatialReference = m_ipMap.SpatialReference
240 Set ipEIDHelper.OutputSpatialReference = ipSpatialReference
241 ipEIDHelper.ReturnGeometries = True
242
243 ' get the details using the IEIDHelper classes
244 Set ipEnumEIDInfo = ipEIDHelper.CreateEnumEIDInfo(m_ipEnumNetEID_Edges)
245 count = ipEnumEIDInfo.count
246
247 ' set the iterator to beginning
248 ipEnumEIDInfo.Reset
249
250 For i = 1 To count
251
252 ' get the next EID and a copy of its geometry (it makes a Clone)
253 Set ipEIDInfo = ipEnumEIDInfo.Next
254 Set ipGeometry = ipEIDInfo.Geometry
255
256 ipNewGeometryColl.AddGeometryCollection ipGeometry
257
258 Next ' EID
259
260 ' return the merged geometry as a Polyline
261 Set PathPolyLine = m_ipPolyline
262
263End Property
264
265' Private
266
267Private Sub CloseWorkspace()
268 ' make sure we let go of everything and start with new results
269 Set m_ipGeometricNetwork = Nothing
270 Set m_ipPoints = Nothing
271 Set m_ipPointToEID = Nothing
272 Set m_ipEnumNetEID_Junctions = Nothing
273 Set m_ipEnumNetEID_Edges = Nothing
274 Set m_ipPolyline = Nothing
275End Sub
276
277Private Function InitializeNetworkAndMap(FeatureDataset As esriGeoDatabase.IFeatureDataset) As Boolean
278
279 Dim ipNetworkCollection As esriGeoDatabase.INetworkCollection
280 Dim ipNetwork As esriGeoDatabase.INetwork
281 Dim count As Long, i As Long
282 Dim ipFeatureClassContainer As esriGeoDatabase.IFeatureClassContainer
283 Dim ipFeatureClass As esriGeoDatabase.IFeatureClass
284 Dim ipGeoDataset As esriGeoDatabase.IGeoDataset
285 Dim ipLayer As esriCarto.ILayer
286 Dim ipFeatureLayer As esriCarto.IFeatureLayer
287 Dim ipEnvelope As esriGeometry.IEnvelope, ipMaxEnvelope As esriGeometry.IEnvelope
288 Dim dblSearchTol As Double
289 Dim dblWidth As Double, dblHeight As Double
290
291 On Error GoTo Trouble
292
293 ' get the networks
294 Set ipNetworkCollection = FeatureDataset
295
296 ' even though a FeatureDataset can have many networks, we'll just
297 ' assume the first one (otherwise you would pass the network name in, etc.)
298
299 ' get the count of networks
300 count = ipNetworkCollection.GeometricNetworkCount
301
302 Debug.Assert count > 0 ' then Exception.Create('No networks found');
303
304 ' get the first Geometric Newtork (0 - based)
305 Set m_ipGeometricNetwork = ipNetworkCollection.GeometricNetwork(0)
306
307 ' get the Network
308 Set ipNetwork = m_ipGeometricNetwork.Network
309
310 ' The EID Helper class that converts points to EIDs needs a
311 ' IMap, so we'll need one around with all our layers added.
312 ' This Pathfinder object has an optional Map property than may be set
313 ' before opening the Network.
314 If m_ipMap Is Nothing Then
315 Set m_ipMap = New esriCarto.Map
316
317 ' Add each of the Feature Classes in this Geometric Network as a map Layer
318 Set ipFeatureClassContainer = m_ipGeometricNetwork
319 count = ipFeatureClassContainer.ClassCount
320 Debug.Assert count > 0 ' then Exception.Create('No (network) feature classes found');
321
322 For i = 0 To count - 1
323 ' get the feature class
324 Set ipFeatureClass = ipFeatureClassContainer.Class(i)
325 ' make a layer
326 Set ipFeatureLayer = New esriCarto.FeatureLayer
327 Set ipFeatureLayer.FeatureClass = ipFeatureClass
328 ' add layer to the map
329 m_ipMap.AddLayer ipFeatureLayer
330 Next
331 End If ' we needed to make a Map
332
333
334 ' Calculate point snap tolerance as 1/100 of map width.
335 count = m_ipMap.LayerCount
336 Set ipMaxEnvelope = New esriGeometry.Envelope
337 For i = 0 To count - 1
338 Set ipLayer = m_ipMap.Layer(i)
339 Set ipFeatureLayer = ipLayer
340 ' get its dimensions (for setting search tolerance)
341 Set ipGeoDataset = ipFeatureLayer
342 Set ipEnvelope = ipGeoDataset.Extent
343 ' merge with max dimensions
344 ipMaxEnvelope.Union ipEnvelope
345 Next
346
347 ' finally, we can set up the IPointToEID 
348 Set m_ipPointToEID = New esriNetworkAnalysis.PointToEID
349 Set m_ipPointToEID.SourceMap = m_ipMap
350 Set m_ipPointToEID.GeometricNetwork = m_ipGeometricNetwork
351
352 ' set snap tolerance
353 dblWidth = ipMaxEnvelope.Width
354 dblHeight = ipMaxEnvelope.Height
355
356 If dblWidth > dblHeight Then
357 dblSearchTol = dblWidth / 100#
358 Else
359 dblSearchTol = dblHeight / 100#
360 End If
361
362 m_ipPointToEID.SnapTolerance = dblSearchTol
363
364 InitializeNetworkAndMap = True ' good to go
365 Exit Function
366
367Trouble:
368 InitializeNetworkAndMap = False ' we had an error
369End Function
370
2
' Copyright 1995-2005 ESRI3
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 IMPLIED9
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS10
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR11
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,12
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF13
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS14
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY15
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY16
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF17
' SUCH DAMAGE.18
19
' For additional information contact: Environmental Systems Research Institute, Inc.20
21
' Attn: Contracts Dept.22
23
' 380 New York Street24
25
' Redlands, California, U.S.A. 9237326
27
' Email: contracts@esri.com28
29
Option Explicit30
31
' vb version of the PathFinder object32
33
' 本地变量34
Private m_ipGeometricNetwork As esriGeoDatabase.IGeometricNetwork35
Private m_ipMap As esriCarto.IMap36
Private m_ipPoints As esriGeometry.IPointCollection37
Private m_ipPointToEID As esriNetworkAnalysis.IPointToEID38
' 返回结果变量 39
Private m_dblPathCost As Double40
Private m_ipEnumNetEID_Junctions As esriGeoDatabase.IEnumNetEID41
Private m_ipEnumNetEID_Edges As esriGeoDatabase.IEnumNetEID42
Private m_ipPolyline As esriGeometry.IPolyline43
44
45
' Optionally set the Map (e.g. the current map in ArcMap),46
' otherwise a default map will be made (for IPointToEID).47
48
Public Property Set Map(Map As esriCarto.IMap)49
Set m_ipMap = Map50
End Property51
52
Public Property Get Map() As esriCarto.IMap53
Set Map = m_ipMap54
End Property55
56
' Either OpenAccessNetwork or OpenFeatureDatasetNetwork57
' needs to be called.58
59
Public Sub OpenAccessNetwork(AccessFileName As String, FeatureDatasetName As String)60
61
Dim ipWorkspaceFactory As esriGeoDatabase.IWorkspaceFactory62
Dim ipWorkspace As esriGeoDatabase.IWorkspace63
Dim ipFeatureWorkspace As esriGeoDatabase.IFeatureWorkspace64
Dim ipFeatureDataset As esriGeoDatabase.IFeatureDataset65
66
' After this Sub exits, we'll have an INetwork interface67
' and an IMap interface initialized for the network we'll be using.68
69
' close down the last one if opened70
CloseWorkspace71
72
' open the mdb73
Set ipWorkspaceFactory = New esriDataSourcesGDB.AccessWorkspaceFactory74
Set ipWorkspace = ipWorkspaceFactory.OpenFromFile(AccessFileName, 0)75
76
' get the FeatureWorkspace77
Set ipFeatureWorkspace = ipWorkspace78
79
' open the FeatureDataset80
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
85
End Sub86
87
Public Sub OpenFeatureDatasetNetwork(FeatureDataset As esriGeoDatabase.IFeatureDataset)88
' close down the last one if opened89
CloseWorkspace90
91
' we assume that the caller has passed a valid FeatureDataset92
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
96
End Sub97
98
' The collection of points to travel through must be set.99
100
Public Property Set StopPoints(Points As esriGeometry.IPointCollection)101
Set m_ipPoints = Points102
End Property103
104
Public Property Get StopPoints() As esriGeometry.IPointCollection105
Set StopPoints = m_ipPoints106
End Property107
108
' Calculate the path109
110
Public Sub SolvePath(WeightName As String)111
112
Dim ipNetwork As esriGeoDatabase.INetwork113
Dim ipTraceFlowSolver As esriNetworkAnalysis.ITraceFlowSolver114
Dim ipNetSolver As esriNetworkAnalysis.INetSolver115
Dim ipNetFlag As esriNetworkAnalysis.INetFlag116
Dim ipaNetFlag() As esriNetworkAnalysis.IEdgeFlag117
Dim ipEdgePoint As esriGeometry.IPoint118
Dim ipNetElements As esriGeoDatabase.INetElements119
Dim intEdgeUserClassID As Long120
Dim intEdgeUserID As Long121
Dim intEdgeUserSubID As Long122
Dim intEdgeID As Long123
Dim ipFoundEdgePoint As esriGeometry.IPoint124
Dim dblEdgePercent As Double125
Dim ipNetWeight As esriGeoDatabase.INetWeight126
Dim ipNetSolverWeights As esriNetworkAnalysis.INetSolverWeights127
Dim ipNetSchema As esriGeoDatabase.INetSchema128
Dim intCount As Long129
Dim i As Long130
Dim vaRes() As Variant131
132
' make sure we are ready133
Debug.Assert Not m_ipPoints Is Nothing134
Debug.Assert Not m_ipGeometricNetwork Is Nothing135
136
' instantiate a trace flow solver137
Set ipTraceFlowSolver = New esriNetworkAnalysis.TraceFlowSolver138
139
' get the INetSolver interface140
Set ipNetSolver = ipTraceFlowSolver141
142
' set the source network to solve on143
Set ipNetwork = m_ipGeometricNetwork.Network144
Set ipNetSolver.SourceNetwork = ipNetwork145
146
' make edge flags from the points147
148
' the INetElements interface is needed to get UserID, UserClassID,149
' and UserSubID from an element id150
Set ipNetElements = ipNetwork151
152
' get the count153
intCount = m_ipPoints.PointCount154
Debug.Assert intCount > 1155
156
' dimension our IEdgeFlag array157
ReDim ipaNetFlag(intCount)158
159
For i = 0 To intCount - 1160
' make a new Edge Flag161
Set ipNetFlag = New esriNetworkAnalysis.EdgeFlag162
Set ipEdgePoint = m_ipPoints.Point(i)163
' look up the EID for the current point (this will populate intEdgeID and dblEdgePercent)164
m_ipPointToEID.GetNearestEdge ipEdgePoint, intEdgeID, ipFoundEdgePoint, dblEdgePercent165
Debug.Assert intEdgeID > 0 ' else Point (eid) not found166
ipNetElements.QueryIDs intEdgeID, esriETEdge, intEdgeUserClassID, intEdgeUserID, intEdgeUserSubID167
Debug.Assert (intEdgeUserClassID > 0) And (intEdgeUserID > 0) ' else Point not found168
ipNetFlag.UserClassID = intEdgeUserClassID169
ipNetFlag.UserID = intEdgeUserID170
ipNetFlag.UserSubID = intEdgeUserSubID171
Set ipaNetFlag(i) = ipNetFlag172
Next173
174
' add these edge flags175
ipTraceFlowSolver.PutEdgeOrigins intCount, ipaNetFlag(0)176
177
' set the weight (cost field) to solve on178
179
' get the INetSchema interface180
Set ipNetSchema = ipNetwork181
Set ipNetWeight = ipNetSchema.WeightByName(WeightName)182
Debug.Assert Not ipNetWeight Is Nothing183
184
' set the weight (use the same for both directions)185
Set ipNetSolverWeights = ipTraceFlowSolver186
Set ipNetSolverWeights.FromToEdgeWeight = ipNetWeight187
Set ipNetSolverWeights.ToFromEdgeWeight = ipNetWeight188
189
' initialize array for results to number of segments in result190
ReDim vaRes(intCount - 1)191
192
' solve it193
ipTraceFlowSolver.FindPath esriFMConnected, esriSPObjFnMinSum, m_ipEnumNetEID_Junctions, m_ipEnumNetEID_Edges, intCount - 1, vaRes(0)194
195
' compute total cost196
m_dblPathCost = 0197
For i = LBound(vaRes) To UBound(vaRes)198
m_dblPathCost = m_dblPathCost + vaRes(i)199
Next200
201
' clear the last polyline result202
Set m_ipPolyline = Nothing203
204
End Sub205
206
' Property to get the cost207
208
Public Property Get PathCost() As Double209
PathCost = m_dblPathCost210
End Property211
212
' Property to get the shape213
214
Public Property Get PathPolyLine() As esriGeometry.IPolyline215
216
Dim ipEIDHelper As esriNetworkAnalysis.IEIDHelper217
Dim count As Long, i As Long218
Dim ipEIDInfo As esriNetworkAnalysis.IEIDInfo219
Dim ipEnumEIDInfo As esriNetworkAnalysis.IEnumEIDInfo220
Dim ipGeometry As esriGeometry.IGeometry221
Dim ipNewGeometryColl As esriGeometry.IGeometryCollection222
Dim ipSpatialReference As esriGeometry.ISpatialReference223
224
' if the line is already computed since the last path, just return it225
If Not m_ipPolyline Is Nothing Then226
Set PathPolyLine = m_ipPolyline227
Exit Property228
End If229
230
Set m_ipPolyline = New esriGeometry.Polyline231
Set ipNewGeometryColl = m_ipPolyline232
233
' a path should be solved first234
Debug.Assert Not m_ipEnumNetEID_Edges Is Nothing235
236
' make an EIDHelper object to translate edges to geometric features237
Set ipEIDHelper = New esriNetworkAnalysis.EIDHelper238
Set ipEIDHelper.GeometricNetwork = m_ipGeometricNetwork239
Set ipSpatialReference = m_ipMap.SpatialReference240
Set ipEIDHelper.OutputSpatialReference = ipSpatialReference241
ipEIDHelper.ReturnGeometries = True242
243
' get the details using the IEIDHelper classes244
Set ipEnumEIDInfo = ipEIDHelper.CreateEnumEIDInfo(m_ipEnumNetEID_Edges)245
count = ipEnumEIDInfo.count246
247
' set the iterator to beginning248
ipEnumEIDInfo.Reset249
250
For i = 1 To count251
252
' get the next EID and a copy of its geometry (it makes a Clone)253
Set ipEIDInfo = ipEnumEIDInfo.Next254
Set ipGeometry = ipEIDInfo.Geometry255
256
ipNewGeometryColl.AddGeometryCollection ipGeometry257
258
Next ' EID259
260
' return the merged geometry as a Polyline261
Set PathPolyLine = m_ipPolyline262
263
End Property264
265
' Private266
267
Private Sub CloseWorkspace()268
' make sure we let go of everything and start with new results269
Set m_ipGeometricNetwork = Nothing270
Set m_ipPoints = Nothing271
Set m_ipPointToEID = Nothing272
Set m_ipEnumNetEID_Junctions = Nothing273
Set m_ipEnumNetEID_Edges = Nothing274
Set m_ipPolyline = Nothing275
End Sub276
277
Private Function InitializeNetworkAndMap(FeatureDataset As esriGeoDatabase.IFeatureDataset) As Boolean278
279
Dim ipNetworkCollection As esriGeoDatabase.INetworkCollection280
Dim ipNetwork As esriGeoDatabase.INetwork281
Dim count As Long, i As Long282
Dim ipFeatureClassContainer As esriGeoDatabase.IFeatureClassContainer283
Dim ipFeatureClass As esriGeoDatabase.IFeatureClass284
Dim ipGeoDataset As esriGeoDatabase.IGeoDataset285
Dim ipLayer As esriCarto.ILayer286
Dim ipFeatureLayer As esriCarto.IFeatureLayer287
Dim ipEnvelope As esriGeometry.IEnvelope, ipMaxEnvelope As esriGeometry.IEnvelope288
Dim dblSearchTol As Double289
Dim dblWidth As Double, dblHeight As Double290
291
On Error GoTo Trouble292
293
' get the networks294
Set ipNetworkCollection = FeatureDataset295
296
' even though a FeatureDataset can have many networks, we'll just297
' assume the first one (otherwise you would pass the network name in, etc.)298
299
' get the count of networks300
count = ipNetworkCollection.GeometricNetworkCount301
302
Debug.Assert count > 0 ' then Exception.Create('No networks found');303
304
' get the first Geometric Newtork (0 - based)305
Set m_ipGeometricNetwork = ipNetworkCollection.GeometricNetwork(0)306
307
' get the Network308
Set ipNetwork = m_ipGeometricNetwork.Network309
310
' The EID Helper class that converts points to EIDs needs a311
' IMap, so we'll need one around with all our layers added.312
' This Pathfinder object has an optional Map property than may be set313
' before opening the Network.314
If m_ipMap Is Nothing Then315
Set m_ipMap = New esriCarto.Map316
317
' Add each of the Feature Classes in this Geometric Network as a map Layer318
Set ipFeatureClassContainer = m_ipGeometricNetwork319
count = ipFeatureClassContainer.ClassCount320
Debug.Assert count > 0 ' then Exception.Create('No (network) feature classes found');321
322
For i = 0 To count - 1323
' get the feature class324
Set ipFeatureClass = ipFeatureClassContainer.Class(i)325
' make a layer326
Set ipFeatureLayer = New esriCarto.FeatureLayer327
Set ipFeatureLayer.FeatureClass = ipFeatureClass328
' add layer to the map329
m_ipMap.AddLayer ipFeatureLayer330
Next331
End If ' we needed to make a Map332
333
334
' Calculate point snap tolerance as 1/100 of map width.335
count = m_ipMap.LayerCount336
Set ipMaxEnvelope = New esriGeometry.Envelope337
For i = 0 To count - 1338
Set ipLayer = m_ipMap.Layer(i)339
Set ipFeatureLayer = ipLayer340
' get its dimensions (for setting search tolerance)341
Set ipGeoDataset = ipFeatureLayer342
Set ipEnvelope = ipGeoDataset.Extent343
' merge with max dimensions344
ipMaxEnvelope.Union ipEnvelope345
Next346
347
' finally, we can set up the IPointToEID 348
Set m_ipPointToEID = New esriNetworkAnalysis.PointToEID349
Set m_ipPointToEID.SourceMap = m_ipMap350
Set m_ipPointToEID.GeometricNetwork = m_ipGeometricNetwork351
352
' set snap tolerance353
dblWidth = ipMaxEnvelope.Width354
dblHeight = ipMaxEnvelope.Height355
356
If dblWidth > dblHeight Then357
dblSearchTol = dblWidth / 100#358
Else359
dblSearchTol = dblHeight / 100#360
End If361
362
m_ipPointToEID.SnapTolerance = dblSearchTol363
364
InitializeNetworkAndMap = True ' good to go365
Exit Function366
367
Trouble:368
InitializeNetworkAndMap = False ' we had an error369
End Function370
