I have searched the old and new forums and not seen any code that inserts new records into a Linear Reference Event Feature Layer using VBA. After some experimenting I found it was not possible to insert the features directly into the LR Event Layer, but it was possible to insert them into the underlying event table.The code below is what I came up with. It duplicates selected LR Event Features by inserting copies into the underlying Event table (I use it to split LR line features when changes in my sidewalk network occur). The code also reselects the original and new duplicated features so that they will display in the LR Event Feature Layer's Tableview. I hope this helps.Sub AddLRRecord()
' Get a reference to the Event Layer through the map.
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pLayer As ILayer
Dim i As Long
For i = 0 To pMap.LayerCount - 1
Set pLayer = pMap.Layer(i)
If pLayer.Name = "SIDEWALKS Events" Then
Exit For
End If
Next i
If pLayer Is Nothing Then
MsgBox "Layer Not Found"
Exit Sub
End If
Dim pFLayer As IFeatureLayer
Set pFLayer = pLayer
' Get the LR Event layer's Selection Set.
Dim pFSel As IFeatureSelection
Set pFSel = pFLayer
Dim pSelSet As ISelectionSet
Set pSelSet = pFSel.SelectionSet
' Create a where clause to select records from underlying event table using OID values.
Dim pEnumIDs As IEnumIDs
Set pEnumIDs = pSelSet.IDs
Dim strWhere As String
strWhere = """OBJECTID"" IN ("
Dim lID As Long
pEnumIDs.Reset
lID = pEnumIDs.Next
Do While lID <> -1
strWhere = strWhere & lID & ","
lID = pEnumIDs.Next
Loop
strWhere = Left(strWhere, Len(strWhere) - 1) & ")"
If strWhere = """OBJECTID"" IN )" Then ' Make sure something was selected
MsgBox "No Sidewalks selected"
Exit Sub
End If
' Select the records in the underlying event table.
Dim pQF As IQueryFilter
Set pQF = New QueryFilter
pQF.WhereClause = strWhere
Dim pRouteEventSource As IRouteEventSource ' This is the interface for getting the Event Table
Set pRouteEventSource = pFLayer.FeatureClass
Dim pTable As ITable
Set pTable = pRouteEventSource.EventTable
Dim pCursor As ICursor
Set pCursor = pTable.Search(pQF, False)
' Copy the records and prepare a new where clause to select original and new features in the LR Event layer.
Dim pICursor As ICursor ' Set up insert cursor for underlying event table.
Set pICursor = pTable.Insert(True)
Dim pRowB As IRowBuffer
Set pRowB = pCursor.NextRow
Dim lFIDC As Long
lFIDC = pRowB.Fields.FindField("FID_CENTERLINE")
Dim lRoadSide As Long
lRoadSide = pRowB.Fields.FindField("ROAD_SIDE")
strWhere = """FID_CENTERLINE"" IN (" ' Create a new query for selecting in LR Event layer.
Dim strWhere2 As String
strWhere2 = " AND ""ROAD_SIDE"" IN ("
Do While Not pRowB Is Nothing
pICursor.InsertRow pRowB ' This duplicates the record in the event table.
strWhere = strWhere & pRowB.Value(lFIDC) & "," ' Adding records to where clause.
strWhere2 = strWhere2 & "'" & pRowB.Value(lRoadSide) & "',"
Set pRowB = pCursor.NextRow
Loop
strWhere = Left(strWhere, Len(strWhere) - 1) & ")"
strWhere2 = Left(strWhere2, Len(strWhere2) - 1) & ")"
strWhere = strWhere & strWhere2
' Reselect original records and duplicated records in the event layer.
pQF.WhereClause = strWhere
pFSel.SelectFeatures pQF, esriSelectionResultNew, False
Set pSelSet = pFSel.SelectionSet ' A SelectionSet will show selection in user tableview.
End Sub
