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
责任编辑：小草
