©2010-2026 宁波自信网络信息技术有限公司 版权所有
客服电话：0574-28810668 投诉电话：18658249818
浙ICP备2021020529号-1 | 浙B2-20240490
关注我们 ：
1、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 A
2、NY 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 (INCL
3、UDING, 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
4、 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
5、26 27' Email: contracts@ 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_ipPoint
6、ToEID 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
7、 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
8、 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.I
9、Workspace 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 d
10、own 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 = ipWor
11、kspace 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 ini
12、tializing 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 ' initial
13、ize 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 StopPoi
14、nts(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)
15、 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 ipE
16、dgePoint 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 Do
17、uble 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 Deb
18、ug.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
19、 ' 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
20、 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 ipNetFl
21、ag = 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 i
22、ntEdgeID > 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
23、 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 t
24、he 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 ipNetSolverWe
25、ights.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_ipEn
26、umNetEID_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 = Nothi
27、ng 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 esriNet
28、workAnalysis.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 ipSpatia
29、lReference 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
30、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.G
31、eometricNetwork = 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.
32、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
33、 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 CloseWorkspac
34、e() 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
35、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 ipFeatureCl
36、assContainer 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.IEnve
37、lope, 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 netwo
38、rks, 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
39、 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 a
40、ll 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
41、 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 =
42、 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 mak
43、e 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 (
44、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 esriNetworkAn
45、alysis.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 = d
46、blWidth / 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
47、Function 附录资料:不需要的可以自行删除 bat文件的基本应用 bat是dos下的批处理文件 .cmd是nt内核命令行环境的另一种批处理文件 从更广义的角度来看，unix的shell脚本以及其它操作系统甚至应用程序中由外壳进行解释执行的文本，都具有与批处理文件十分相似的作用，而且同样是由专用解释器以行为单位解释执行，这种文本形式更通用的称谓是脚本语言。所以从某个程度分析，batch, unix shell, awk, basic, perl 等脚本语言都是一样的，只不过应用的范围和解释的平台各有不同而已。甚至有些应用程序仍然沿用批处理这一称呼，而其内容和扩展名与dos的批
48、处理却又完全不同。 =================================== 首先批处理文件是一个文本文件，这个文件的每一行都是一条DOS命令（大部分时候就好象我们在DOS提示符下执行的命令行一样），你可以使用DOS下的Edit或者Windows的记事本(notepad)等任何文本文件编辑工具创建和修改批处理文件。 ==== 注 =================== 批处理文件中完全可以使用非dos命令，甚至可以使用不具有可执行特性的普通数据性文件，这缘于windows系统这个新型解释平台的涉入，使得批处理的应用越来越"边缘化"。所以我们讨论的批处理应该
49、限定在dos环境或者命令行环境中，否则很多观念和设定都需要做比较大的变动。 ======================== 其次，批处理文件是一种简单的程序，可以通过条件语句(if)和流程控制语句(goto)来控制命令运行的流程，在批处理中也可以使用循环语句(for)来循环执行一条命令。当然，批处理文件的编程能力与C语言等编程语句比起来是十分有限的，也是十分不规范的。批处理的程序语句就是一条条的DOS命令（包括内部命令和外部命令），而批处理的能力主要取决于你所使用的命令。 ==== 注 ================== 批处理文件(batch file)也可以称之为批处理程序(batch program)，这一点与编译型语言有所不同，就c语言来说，扩展名为c或者cpp的文件可以称之为c语言文件或者c语言源代码，但只有编译连接后的exe文件才可以称之为c语言程序。因为批处理文件本身既具有文本的可读性，又具有程序的可执行性，这些称谓的界限是比较模糊的。 =========================== 第三，每个编写好的批处理文件都相当于一个DOS的外部命令，你可以把它所在的目录放到你的DOS搜索路径(path)中来使得它可以在任意位置运行。一个良好的习惯是在硬盘上建立一个bat或者batch目录（例如C:\BATCH），
©2010-2026 宁波自信网络信息技术有限公司 版权所有
客服电话：0574-28810668 投诉电话：18658249818
浙ICP备2021020529号-1 | 浙B2-20240490
关注我们 ：
