Add event error codes to event table

Created:11/09/2000
Description:

In a RouteEventSource, there is one feature for every row of the original event table. In some cases, however, the features have empty shapes. This is because there was some reason the event could not be properly located. Other times, an event can only be partially located (this happens for line events only). The IEventSourceErrors interface exposes some methods that allow you to determine the locating errors of events. The following sample shows how to add a field to an event source. Then a cursor is established which loops through all the features and figures out if the event located properly.

How to use:
  1. Paste the code into VB/VBA.
  2. Write code that calls AddEventErrors
Public Sub AddEventErrors(pRES As IRouteEventSource)

  '+++ Refer to other Dynamic Segmentation samples on how to create a
  '+++ RouteEventSource object 

  On Error GoTo eh

  '+++ Create a field called ErrCode
  Dim pFld As IFieldEdit
  Set pFld = New Field
  With pFld
    .Name = "ErrCode"
    .Type = esriFieldTypeString
    .Length = 50
  End With
  
  '+++ Add the field to the route event source (this actually adds the field to
  '+++ the event table)
  Dim pFC As IFeatureClass
  Set pFC = pRES
  pFC.AddField pFld
   
  '+++ Create an Update cursor. This means changes cannot be undone.
  Dim pCur As IFeatureCursor
  Set pCur = pFC.Update(Nothing, False)
  
  
  '+++ Find the index field
  Dim lIdx As Long
  Dim pFlds As IFields
  Set pFlds = pCur.Fields
  lIdx = pCur.FindField("ErrCode")
  
  
  '+++ QI for the IEventSourceErrors interface. This gives us access to the locating
  '+++ errors
  Dim pESErrors As IEventSourceErrors
  Dim pFeat As IFeature
  Dim lError As esriLocatingError
  Set pESErrors = pRES
  
 '+++ Loop through the features in a route event source and get the errors
  Set pFeat = pCur.NextFeature
  While Not pFeat Is Nothing
    lError = pESErrors.GetLocatingErrorRow(pFeat)
    pFeat.Value(lIdx) = GetEventError(lError)
    pCur.UpdateFeature pFeat
    Set pFeat = pCur.NextFeature
  Wend
  
  Set pCur = Nothing
  
  Exit Sub
  
eh:
  Dim sDesc As String
  sDesc = Err.Description
  Debug.Print sDesc
  MsgBox sDesc, vbExclamation, "Error in AddEventErrors"
  
End Sub



Public Function GetEventError(LocError As esriLocatingError) As String
  Select Case LocError
    Case 0
      GetEventError = "LOCATING_OK"
    Case 1
      GetEventError = "LOCATING_E_INVALIDRID"
    Case 2
      GetEventError = "LOCATING_E_INVALIDMEASURE"
    Case 3
      GetEventError = "LOCATING_E_CANT_FIND_ROUTE"
    Case 4
      GetEventError = "LOCATING_E_ROUTE_SHAPE_EMPTY"
    Case 5
      GetEventError = "LOCATING_E_CANT_FIND_LOCATION"
    Case 6
      GetEventError = "LOCATING_E_CANT_FIND_EXTENT"
    Case 7
      GetEventError = "LOCATING_E_FROM_PARTIAL_MATCH"
    Case 8
      GetEventError = "LOCATING_E_TO_PARTIAL_MATCH"
    Case 9
      GetEventError = "LOCATING_E_ROUTE_MS_NULL"
    Case 10
      GetEventError = "LOCATING_E_ROUTE_NOT_MAWARE"
    Case 11
      GetEventError = "LOCATING_E_ROUTE_FROM_TO_PARTIAL_MATCH"
    Case Else
      GetEventError = "INVALID_LOCATING_ERROR"
  End Select
End Function