This ArcObjects script below will create a line shp between records stored in a dbf that have the same attribute values. It is a bit lengthy, but does the trick. To run it the dbf needs an ID field, and both X and Y fields (update the code to match your field names).
You could assign the code below to a UIControl (button). The link below will show you how to create a UI Control in ArcMap.
Creating custom commands with VBA and UI Controls
Public Sub ConnectPointFeatures()
'----- open the table -----
Dim pWorkspaceFactoryTable As IWorkspaceFactory
Set pWorkspaceFactoryTable = New ShapefileWorkspaceFactory
Dim pWorkspaceTable As IWorkspace
Dim pFWSTable As IFeatureWorkspace
Dim path As String
path = "C:\Temp"
Set pWorkspaceTable = pWorkspaceFactoryTable.OpenFromFile(path, 0)
Dim pTable As ITable
Set pFWSTable = pWorkspaceTable
Dim xtable As String
xtable = "Connect dots.dbf"
Set pTable = pFWSTable.OpenTable(xtable)
Dim ID_in_index As Integer
Dim ID_in_type As String
Dim pFields As IFields
Dim pField As IField
Set pFields = pTable.Fields
ID_in_index = pFields.FindField("APPNO")
Set pField = pFields.field(ID_in_index)
ID_in_type = pField.Type
'***** create shapefile function -- do it here to generate correct ID field type
CreateShapefile (ID_in_type)
'***** create shapefile function *****
'----- set up table and table properties to read -----
Dim pCursor As ICursor
Dim pQueryFilter As IQueryFilter2
Set pQueryFilter = New QueryFilter
If ID_in_type >= 0 And ID_in_type < 4 Then pQueryFilter.WhereClause = "POINT_X" & " <> 0 AND " & "POINT_Y" & " <> 0 AND " & "APPNO" & " >= 0"
If ID_in_type = 4 Then pQueryFilter.WhereClause = "APPNO" & " <> ''"
If ID_in_type > 4 Then
MsgBox ("ID field type not supported --> Processing terminated.")
Exit Sub
End If
Set pCursor = pTable.Search(pQueryFilter, True)
Dim pRow As IRow
Dim RowCounter As Long
Dim RowCount As Long
RowCount = pTable.RowCount(pQueryFilter)
''''''''''''''''''''''''
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pWorkSpace As IWorkspace
Dim pFWS As IFeatureWorkspace
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFWS = pWorkspaceFactory.OpenFromFile(tbOutputPath, 0)
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFWS.OpenFeatureClass(tbOutputFile)
Dim pDataset As IDataset
Set pDataset = pFeatureClass
Dim ID_out_index As Variant
ID_out_index = pFeatureClass.FindField("APPNO")
'----- create variables to store X Y & IDs -----
Dim xVal As Double
Dim yVal As Double
Dim xVal2 As Double
Dim yVal2 As Double
Dim rowID As Variant
Dim rowID2 As Variant
'----- get field indexes for fields to read from -----
Dim Xindex As Integer
Dim Yindex As Integer
Dim IDindex As Integer
Xindex = pTable.FindField("POINT_X")
Yindex = pTable.FindField("POINT_Y")
IDindex = pTable.FindField("APPNO")
'----- create variables to generate a new feature and populate fields-----
Dim pGeomColl As IGeometryCollection
Dim pSegColl As ISegmentCollection
Dim pLine As ILine, pPolyline As IPolyline
Dim pFeature As IFeature
Set pSegColl = New path
'***** DO IT *****
'----- if merging by segment IDs -----
fol = "C:\Temp"
'change to match the folder path
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(fol) Then
'If cbMergebyID.Value = False Then
'--- get first row ---
Set pRow = pCursor.NextRow
xVal = pRow.value(Xindex)
yVal = pRow.value(Yindex)
rowID = pRow.value(IDindex)
'--- get second row ---
Set pRow = pCursor.NextRow
xVal2 = pRow.value(Xindex)
yVal2 = pRow.value(Yindex)
rowID2 = pRow.value(IDindex)
'--- if second is same ID as first then start the feature ---
If rowID2 = rowID Then
Set pLine = CreateLn(CreatePt(xVal, yVal), CreatePt(xVal2, yVal2))
Set pSegColl = New path
pSegColl.AddSegment pLine
End If
'--- assign second row to fnode position ---
xVal = xVal2
yVal = yVal2
'zVal = zVal2
rowID = rowID2
Set pRow = pCursor.NextRow
RowCounter = 2
Do Until pRow Is Nothing
RowCounter = RowCounter + 1
frmPoints2Lines.Caption = "Processing " & RowCounter & " of " & RowCount & " total points."
xVal2 = pRow.value(Xindex)
yVal2 = pRow.value(Yindex)
rowID2 = pRow.value(IDindex)
'--- if next row has same id then add a line segment to seg collection ---
If rowID2 = rowID Then
Set pLine = CreateLn(CreatePt(xVal, yVal), CreatePt(xVal2, yVal2))
pSegColl.AddSegment pLine
'--- otherwise, if seg collection has any segs then make a polyline ---
ElseIf pSegColl.SegmentCount > 0 Then
Set pGeomColl = New Polyline
pGeomColl.AddGeometry pSegColl
Set pFeature = pFeatureClass.CreateFeature
Set pPolyline = pGeomColl
Set pFeature.Shape = pPolyline
pFeature.value(ID_out_index) = rowID
pFeature.Store
pSegColl.RemoveSegments 0, pSegColl.SegmentCount, False
End If
'--- backcalculate to-pt to from-pt
xVal = xVal2
yVal = yVal2
'zVal = zVal2
rowID = rowID2
Set pRow = pCursor.NextRow
Loop
'--- deal with last line of file ---
If rowID = rowID2 Then
Set pGeomColl = New Polyline
pGeomColl.AddGeometry pSegColl
Set pFeature = pFeatureClass.CreateFeature
Set pPolyline = pGeomColl
Set pFeature.Shape = pPolyline
pFeature.value(ID_out_index) = rowID
pFeature.Store
End If
'----- if NOT merging by segment IDs -----
'ElseIf cbMergebyID.Value = False Then
Else
'--- get first row ---
Set pRow = pCursor.NextRow
xVal = pRow.value(Xindex)
yVal = pRow.value(Yindex)
rowID = pRow.value(IDindex)
Set pRow = pCursor.NextRow
RowCounter = 2
Do Until pRow Is Nothing
RowCounter = RowCounter + 1
frmPoints2Lines.Caption = "Processing " & RowCounter & " of " & RowCount & " total points."
xVal2 = pRow.value(Xindex)
yVal2 = pRow.value(Yindex)
rowID2 = pRow.value(IDindex)
'--- if next row has same id then add a line segment to seg collection ---
If rowID2 = rowID Then
Set pLine = CreateLn(CreatePt(xVal, yVal), CreatePt(xVal2, yVal2))
Set pSegColl = New path
pSegColl.AddSegment pLine
Set pGeomColl = New Polyline
pGeomColl.AddGeometry pSegColl
Set pFeature = pFeatureClass.CreateFeature
Set pPolyline = pGeomColl
Set pFeature.Shape = pPolyline
pFeature.value(ID_out_index) = rowID
pFeature.Store
End If
xVal = xVal2
yVal = yVal2
rowID = rowID2
Set pRow = pCursor.NextRow
Loop
End If
End Sub
Private Function CreateShapefile(ByVal ID_in_type As String)
'----- delete if shapefile already exists -----
Dim pFWS As IFeatureWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
'Dim tbOutputPath As String
tbOutputPath = "C:\Temp"
'Dim tbOutputFile As String
tbOutputFile = "Line"
Set pFWS = pWorkspaceFactory.OpenFromFile(tbOutputPath, 0)
Dim pFeatClass As IFeatureClass
Dim pDataset As IDataset
'----- if shapefile exists then delete -----
Dim pFSO As Object
Set pFSO = CreateObject("Scripting.FileSystemObject")
If pFSO.FileExists(tbOutputPath & "\" & tbOutputFile) Then
Set pFeatClass = pFWS.OpenFeatureClass(tbOutputFile)
If (Not pFeatClass Is Nothing) Then
Set pDataset = pFeatClass
pDataset.Delete
End If
End If
'----- Set up the shapefile geometry field -----
Dim pFields As IFields
Dim pFieldsEdit As IFieldsEdit
Set pFields = New Fields
Set pFieldsEdit = pFields
Dim pField As IField
Dim pFieldEdit As IFieldEdit
Set pField = New field
Set pFieldEdit = pField
pFieldEdit.name = "Shape"
pFieldEdit.Type = esriFieldTypeGeometry
Dim pGeomDef As IGeometryDef
Dim pGeomDefEdit As IGeometryDefEdit
Set pGeomDef = New GeometryDef
Set pGeomDefEdit = pGeomDef
With pGeomDefEdit
.GeometryType = esriGeometryPolyline
Set .SpatialReference = New UnknownCoordinateSystem
End With
Set pFieldEdit.GeometryDef = pGeomDef
pFieldsEdit.AddField pField
'----- Add an ID field for relate back to point source field -----
Set pField = New field
Set pFieldEdit = pField
With pFieldEdit
.name = "APPNO"
.Type = ID_in_type
End With
pFieldsEdit.AddField pField
'----- Create the shapefile -----
Set pFeatClass = pFWS.CreateFeatureClass(tbOutputFile, pFields, Nothing, Nothing, esriFTSimple, "Shape", "")
End Function
Private Function CreatePt(ByVal dX As Double, _
ByVal dY As Double) As IPoint
Set CreatePt = New Point
CreatePt.PutCoords dX, dY
End Function
Private Function CreateLn(ByRef pPointFrom As IPoint, pPointTo As IPoint) As ILine
Set CreateLn = New Line
CreateLn.PutCoords pPointFrom, pPointTo
End Function