How to convert a route event table to a feature class

Public Sub ConvertEventsToFeatureClass(sAccessWS As String, sRouteFC As String, sEventTable As String, sRkeyField As String, sOffsetField As String, sMeasureField As String, sOutputDSName, sWhereClause)
    
    '+++ This sample shows how to convert a point event table into
    '+++ a persistent feature class on your disk. To do this, we use the Dynamic
    '+++ Segmentation and Feature Data Converter ArcObjects.
    
    '+++ VARIABLES
    '+++ sAccessWS - access Workspace (i.e "\\rockytop\data\dyndata\test.mdb")
    '+++ sRouteFC - route feature class (i.e. "hwym")
    '+++ sEventTable - point event table (i.e "accidents")
    '+++ sRkeyField - route identifier field for event table and Route Feature Class (i.e. "rkey")
    '+++ sOffsetField - event table offset field(i.e. "Offset")
    '+++ sMeasureField - event table measure field (i.e "mile")
    '+++ sOutputDSName - name of output Feature Dataset to create (i.e "Roads_Events")
    '+++ sWhereClause - query filter to apply (i.e. "rkey > 200")
    
    
    
    On Error GoTo eh
    
    '+++ We'll use a route feature class and an event table from a personal Geodatabase
    '+++ This is not a requirement for this code to work.
    
    Dim pWS As IWorkspace
    Dim pWorkspaceFactory As IWorkspaceFactory
    Dim pFWS As IFeatureWorkspace
    Dim pRouteFc As IFeatureClass
    Dim pEventTable As ITable
    Set pWorkspaceFactory = New AccessWorkspaceFactory
    Set pWS = pWorkspaceFactory.OpenFromFile(sAccessWS, 0)
    Set pFWS = pWS
    Set pRouteFc = pFWS.OpenFeatureClass(sRouteFC)
    Set pEventTable = pFWS.OpenTable(sEventTable)
    
    
    '+++ Some variables to be (re)used throughout
    
    Dim pTempWS As IWorkspace
    Dim pTempDSN As IDatasetName
    Dim pTempDs As IDataset
    Dim pTempGDS As IGeoDataset
    Dim pTempName As IName
    Dim pEnumDSN As IEnumDatasetName
    Dim pTempFC As IFeatureClass
    Dim pTempFWS As IFeatureWorkspace
    
    
    '+++ Set up a RouteMeasureLocatorName (to be passed to RouteEventSourceName)
    
    Dim pRMLocName As IRouteLocatorName
    Set pTempDs = pRouteFc
    Set pTempName = pTempDs.FullName
    Set pRMLocName = New RouteMeasureLocatorName
    With pRMLocName
        Set .RouteFeatureClassName = pTempName
        .RouteIDFieldName = sRkeyField
        .RouteIDIsUnique = True
        .RouteMeasureUnit = esriUnknownUnits
    End With
    
    '+++ Create the input EventTableName (used by the RouteEventSourceName)
    
    Dim pEventTableName As IDatasetName
    Set pTempDs = pEventTable
    Set pTempName = pTempDs.FullName
    Set pEventTableName = pTempName
    
    '+++ Create some event properties. For point events,
    '+++ you use RouteMeasurePointProperties. For line events,
    '+++ you would use RouteMeasureLineProperties
    
    Dim pRtProp As IRouteEventProperties
    Dim pRMPtProp As IRouteMeasurePointProperties
    Set pRtProp = New RouteMeasurePointProperties
    With pRtProp
        .EventMeasureUnit = esriUnknownUnits
        .EventRouteIDFieldName = sRkeyField
        '.LateralOffsetFieldName = sOffsetField
    End With
    Set pRMPtProp = pRtProp
    pRMPtProp.MeasureFieldName = sMeasureField
    
    '+++ Set up the RouteEventSourceName
    
    Dim pEventsourceName As IRouteEventSourceName
    Set pEventsourceName = New RouteEventSourceName
    With pEventsourceName
        Set .EventProperties = pRMPtProp
        Set .EventTableName = pEventTableName
        Set .RouteLocatorName = pRMLocName
    End With
    
    
    '+++ We'll write the results out to the same workspace as the event table
    
    Dim pOutDSN As IDatasetName
    Dim pOutWSN As IWorkspaceName
    Dim pOutFeatDSN As IFeatureDatasetName
    
    Set pTempDs = pEventTable
    Set pTempWS = pTempDs.Workspace
    Set pOutWSN = New WorkspaceName
    pOutWSN.ConnectionProperties = pTempWS.ConnectionProperties
    If pTempWS.Type = esriRemoteDatabaseWorkspace Then
        pOutWSN.WorkspaceFactoryProgID = "esriDataSourcesGDB.SdeWorkspaceFactory.1"
    ElseIf pTempWS.Type = esriLocalDatabaseWorkspace Then
        pOutWSN.WorkspaceFactoryProgID = "esriDataSourcesGDB.AccessWorkspaceFactory.1"
    Else
        pOutWSN.WorkspaceFactoryProgID = "esriDataSourcesFile.ShapefileWorkspaceFactory.1"
    End If
    
    
    '+++ Optional: Create the output FeatureDatasetName object. You can create a new one
    '+++           or Write to an existing one.
    
    If Not pOutWSN.Type = esriFileSystemWorkspace Then '+++ makes no sense for shapefile
        Set pOutFeatDSN = New FeatureDataSetName
        Set pOutDSN = pOutFeatDSN
        Set pOutDSN.WorkspaceName = pOutWSN
        pOutDSN.Name = sOutputDSName
    End If
    
    '+++ Create the new output FeatureClassName object
    
    Dim pOutFCN As IFeatureClassName
    Dim pOutDSN2 As IDatasetName
    Set pOutFCN = New FeatureClassname
    Set pOutDSN2 = pOutFCN
    Set pOutDSN2.WorkspaceName = pOutWSN 'esp. necessary when pOutDSN is Nothing
    Set pTempDs = pEventTable
    pOutDSN2.Name = pTempDs.BrowseName & "_Events"
    
    
    '+++ Open the eventsource to get a feature class. The fields of this event source
    '+++ will be run through the field checker.
    
    Dim pFC As IFeatureClass
    Dim pEvtSrc As IRouteEventSource
    Set pTempName = pEventsourceName
    Set pEvtSrc = pTempName.Open
    Set pFC = pEvtSrc
    
    '+++ Get the event source's fields and run them through the field checker
    
    Dim pFlds As IFields
    Dim pOutFlds As IFields
    Dim pFldChk As IFieldChecker
    Set pFlds = pFC.Fields
    Set pFldChk = New FieldChecker
    Set pTempName = pOutWSN
    Set pTempWS = pTempName.Open
    Set pFldChk.ValidateWorkspace = pTempWS
    pFldChk.Validate pFlds, Nothing, pOutFlds
    If Not pFlds.FieldCount = pOutFlds.FieldCount Then
        MsgBox "The number of fields returned by the field checker is less than the input." _
            & vbCrLf & "Cannot create output feature class", vbExclamation, "ConvertEvents"
        GoTo endproc
    End If
    
    '+++ Optional: Use a query filter
    Dim pQFilt As IQueryFilter
    'Set pQFilt = New QueryFilter
    'pQFilt.WhereClause = sWhereClause
    Set pQFilt = Nothing
    
    '+++ Convert the RouteEventSourceName
    
    Dim pEnum As IEnumInvalidObject
    Dim pConv As IFeatureDataConverter2
    Set pConv = New FeatureDataConverter
    Set pEnum = pConv.ConvertFeatureClass(pEventsourceName, pQFilt, Nothing, pOutFeatDSN, _
                pOutFCN, Nothing, pOutFlds, "", 1000, 0)
    
    
    '+++ Code to make sure pEnumvalidObject does not reject any features
    Dim pInvalidInfo As IInvalidObjectInfo
    pEnum.Reset
    Set pInvalidInfo = pEnum.Next
    While Not pInvalidInfo Is Nothing
        Debug.Print pInvalidInfo.InvalidObjectID & ": " & pInvalidInfo.ErrorDescription
        Set pInvalidInfo = pEnum.Next
    Wend
    
    GoTo endproc
eh:
    Dim lNum As Long, sDesc As String, sSrc As String
    lNum = Err.Number
    sDesc = Err.Description
    sSrc = Err.Source
    Err.Raise lNum, "ConvertEvents via " & sSrc, sDesc
endproc:
    Set pWS = Nothing
    Set pFWS = Nothing
    Set pWorkspaceFactory = Nothing
    Set pTempWS = Nothing
    Set pTempDSN = Nothing
    Set pTempDs = Nothing
    Set pTempGDS = Nothing
    Set pTempName = Nothing
    Set pEnumDSN = Nothing
    Set pTempFC = Nothing
    Set pTempFWS = Nothing
    Set pRMLocName = Nothing
    Set pEventTableName = Nothing
    Set pEventsourceName = Nothing
    Set pOutDSN = Nothing
    Set pOutWSN = Nothing
    Set pOutFeatDSN = Nothing
    Set pOutFCN = Nothing
    Set pOutDSN2 = Nothing
    Set pFC = Nothing
    Set pEvtSrc = Nothing
    Set pFlds = Nothing
    Set pOutFlds = Nothing
    Set pQFilt = Nothing
    Set pFldChk = Nothing
    Set pEnum = Nothing
    Set pConv = Nothing
End Sub