AddLocations = FAIL With VB6 app

442
0
10-21-2010 12:20 PM
CraigGraham
New Contributor III
Good Afternoon
  I have built a sub (below) which is called by a code on a form.  The form controls set a series of globals with the values that sub needs for various network analyst GP commands. 

The form calls the sub by looping through a user selected layer of processing facilities, exporting a single facility, calling the sub to create the service area for that facility, and then deleting everything but the lines (keeps polys if the user chooses to make them), then the form exports the next facility.

The sub works fine provided the user doesn't request barriers be used in creating the lines.  When barriers are needed it fails on line 196 (pGp.AddLocations_na).  This is despite the fact that adding the facility works with the same call (line 190)

If anyone has any ideas on what I'm doing wrong, I'd really appreciate your input.

Take care,
Craig

Public Sub subMakeLines(sAccum As String, sImpedAtt As String, sDefBreakVal As String, sOutPath As String, sNetworkPath As String, sFacilitySHPName As String, sOutName As String, sOutPolyName As String)
  On Error GoTo ErrorHandler

 
    Dim pDoc As IMxDocument, pMap As IMap, pLayers As IEnumLayer, pLayer As ILayer2, pGp As Object, pFLayer As IFeatureLayer2, pFClass As IFeatureClass
    Dim pDS As IDataset, pFClassName As IFeatureClassName, pDSName As IDatasetName
    Dim pExOp As IExportOperation, pWSNameOut As IWorkspaceName2, pFieldSHP As IField, pPropSet As IPropertySet2, pWSF As IWorkspaceFactory
    Dim pDSNameOut As IDatasetName, pFClassNameOut As IFeatureClassName, pSelSet As ISelectionSet2, pName As IName, pWSOut As IWorkspace
    Dim sBarrierPath As String
    
184:     frmExportFeaturesToSHP.lbStatus = "Processing: " & Globals.g_iFeatNum & " of " & Globals.g_iFeatCount & " Facilities!"
185:     frmExportFeaturesToSHP.Refresh
186:     Set pGp = CreateObject("esriGeoprocessing.GpDispatch.1")
187:     pGp.Toolbox = "C:\Program Files\ArcGIS\ArcToolbox\Toolboxes\Network Analyst Tools.tbx"
188:     pGp.MakeServiceAreaLayer_na sNetworkPath, "LineServiceArea", sImpedAtt, "TRAVEL_FROM", sDefBreakVal, g_sPolyType, g_sMultiFacOptions, g_sOverlapType, "TRUE_LINES", "OVERLAP", "NO_SPLIT", g_sExcludedSources, sAccum, "ALLOW_UTURNS", "", g_sTrimPoly, g_sTrimThres, "LINES_SOURCE_FIELDS"
' Process: Add Locations...
190:     pGp.AddLocations_na "LineServiceArea", "Facilities", sFacilitySHPName, "Name Label #;CurbApproach # 0;Attr_Minutes_All_Modes # 0;Attr_Minutes_Only_Roads # 0;Attr_Minutes_Road_Rail # 0;Attr_Minutes_Road_Ship # 0;Attr_Distance_All_Modes # 0;Attr_Distance_Only_Roads # 0;Attr_Distance_Road_Rail # 0;Attr_Distance_Road_Ship # 0;Attr_FAMU_Cost # 0", "5000 Meters", "", "FAMU_RoadNet SHAPE;Rail NONE;Rail_transfer_arcs NONE;Ship_transfer_arcs NONE;Shipping_routes NONE;Docks NONE;Rail_Sidings NONE;Street_Rail_Connect NONE;FAMU_RoadNet_ND_Junctions NONE;Street_Ship_Connect NONE", "PRIORITY", "CLEAR", "NO_SNAP", "5 Meters"
' Process: Add Road Barriers...
193:     If g_sRoadBarriers = "USE" Then
194:         sBarrierPath = sNetworkPath
195:         sBarrierPath = Left(sBarrierPath, Len(sBarrierPath) - 28) & "Barriers\OutOfPov_barrier"
196:         pGp.AddLocations_na "LineServiceArea", "Barriers", sBarrierPath, "Name Location #;CurbApproach # 0;Attr_Minutes_All_Modes # 0;Attr_Minutes_Only_Roads # 0;Attr_Minutes_Road_Rail # 0;Attr_Minutes_Road_Ship # 0;Attr_Distance_All_Modes # 0;Attr_Distance_Only_Roads # 0;Attr_Distance_Road_Rail # 0;Attr_Distance_Road_Ship # 0;Attr_FAMU_Cost # 0", "5000 Meters", "", "FAMU_RoadNet SHAPE;Rail NONE;Rail_transfer_arcs NONE;Ship_transfer_arcs NONE;Shipping_routes NONE;Docks NONE;Rail_Sidings NONE;Street_Rail_Connect NONE;FAMU_RoadNet_ND_Junctions NONE;Street_Ship_Connect NONE", "MATCH_TO_CLOSEST", "APPEND", "NO_SNAP", "5 Meters"
198:     End If
' Process: Add Rail Barriers...
200:     If g_sRailBarriers = "USE" Then
201:         sBarrierPath = sNetworkPath
202:         sBarrierPath = Left(sBarrierPath, Len(sBarrierPath) - 28) & "Barriers\US_Rail_barrier"
203:         pGp.AddLocations_na "LineServiceArea", "Barriers", sBarrierPath, "Name Location #;CurbApproach # 0;Attr_Minutes_All_Modes # 0;Attr_Minutes_Only_Roads # 0;Attr_Minutes_Road_Rail # 0;Attr_Minutes_Road_Ship # 0;Attr_Distance_All_Modes # 0;Attr_Distance_Only_Roads # 0;Attr_Distance_Road_Rail # 0;Attr_Distance_Road_Ship # 0;Attr_FAMU_Cost # 0", "5000 Meters", "", "FAMU_RoadNet SHAPE;Rail NONE;Rail_transfer_arcs NONE;Ship_transfer_arcs NONE;Shipping_routes NONE;Docks NONE;Rail_Sidings NONE;Street_Rail_Connect NONE;FAMU_RoadNet_ND_Junctions NONE;Street_Ship_Connect NONE", "MATCH_TO_CLOSEST", "APPEND", "NO_SNAP", "5 Meters"
204:     End If
205:     pGp.Solve_na "LineServiceArea", "SKIP"
' Process: Select Data...
207:     pGp.Toolbox = "C:\Program Files\ArcGIS\ArcToolbox\Toolboxes\Data Management Tools.tbx"
208:     pGp.SelectData_management "LineServiceArea", "Lines"
' Export Linework
210:     Set pDoc = g_App.Document
211:     Set pMap = pDoc.FocusMap
212:     Set pLayers = pMap.Layers
213:     Set pLayer = pLayers.Next
214:     Do Until pLayer Is Nothing
215:         If pLayer.Name = "Lines" Then
216:             Set pFLayer = pLayer
217:             Set pFClass = pFLayer.FeatureClass
218:             Set pDS = pFClass
219:             Set pFClassName = pDS.FullName
220:             Set pDSName = pFClassName
221:             Set pSelSet = pFClass.Select(Nothing, esriSelectionTypeIDSet, esriSelectionOptionNormal, Nothing)
222:             Set pFieldSHP = pFClass.Fields.Field(pFClass.FindField(pFClass.ShapeFieldName))
223:             Set pWSF = New ShapefileWorkspaceFactory
224:             Set pWSNameOut = pWSF.Create(sOutPath, "TempWS", Nothing, 0)
225:             Set pName = pWSNameOut
226:             Set pWSOut = pName.Open
227:             Set pPropSet = New PropertySet
228:             pPropSet.SetProperty "DATABASE", sOutPath
229:             Set pWSNameOut = New WorkspaceName
230:             pWSNameOut.ConnectionProperties = pPropSet
231:             pWSNameOut.WorkspaceFactoryProgID = "esriDataSourcesFile.shapefileWorkspaceFactory.1"
232:             Set pFClassNameOut = New FeatureClassName
233:             Set pDSNameOut = pFClassNameOut
234:             Set pDSNameOut.WorkspaceName = pWSNameOut
235:             pDSNameOut.Name = sOutName
236:             Set pExOp = New ExportOperation
237:             pExOp.ExportFeatureClass pDSName, Nothing, pSelSet, pFieldSHP.GeometryDef, pFClassNameOut, 0
238:         End If
239:         Set pLayer = pLayers.Next
240:     Loop
' Export Polygons if selected
242:     If Not Globals.g_sPolyType = "NO_POLYS" Then
243:         pGp.SelectData_management "LineServiceArea", "Polygons"
244:         Set pGp = Nothing
245:         Set pLayers = pMap.Layers
246:         Set pLayer = pLayers.Next
247:         Do Until pLayer Is Nothing
248:             If pLayer.Name = "Polygons" Then
249:                 Set pFLayer = pLayer
250:                 Set pFClass = pFLayer.FeatureClass
251:                 Set pDS = pFClass
252:                 Set pFClassName = pDS.FullName
253:                 Set pDSName = pFClassName
254:                 Set pSelSet = pFClass.Select(Nothing, esriSelectionTypeIDSet, esriSelectionOptionNormal, Nothing)
255:                 Set pFieldSHP = pFClass.Fields.Field(pFClass.FindField(pFClass.ShapeFieldName))
256:                 Set pWSF = New ShapefileWorkspaceFactory
257:                 Set pWSNameOut = pWSF.Create(sOutPath, "TempWS", Nothing, 0)
258:                 Set pName = pWSNameOut
259:                 Set pWSOut = pName.Open
260:                 Set pPropSet = New PropertySet
261:                 pPropSet.SetProperty "DATABASE", sOutPath
262:                 Set pWSNameOut = New WorkspaceName
263:                 pWSNameOut.ConnectionProperties = pPropSet
264:                 pWSNameOut.WorkspaceFactoryProgID = "esriDataSourcesFile.shapefileWorkspaceFactory.1"
265:                 Set pFClassNameOut = New FeatureClassName
266:                 Set pDSNameOut = pFClassNameOut
267:                 Set pDSNameOut.WorkspaceName = pWSNameOut
268:                 pDSNameOut.Name = sOutName
269:                 Set pExOp = New ExportOperation
270:                 pExOp.ExportFeatureClass pDSName, Nothing, pSelSet, pFieldSHP.GeometryDef, pFClassNameOut, 0
271:             End If
272:             Set pLayer = pLayers.Next
273:         Loop
274:     End If
'Remove Created Layers from Map
275:     Set pLayers = pMap.Layers
276:     Set pLayer = pLayers.Next
277:     Do Until pLayer Is Nothing
278:         If pLayer.Name = "LineServiceArea" Then
279:             pMap.DeleteLayer pLayer
280:         End If
287:         Set pLayer = pLayers.Next
288:     Loop
289:     pDoc.UpdateContents
290:     g_App.RefreshWindow
  Exit Sub
ErrorHandler:
  HandleError True, "subMakeLines " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Sub
Tags (2)
0 Kudos
0 Replies