| |
Public Sub PointPoint()
Dim pMxApplication As IMxApplication
Dim pMxDocument As IMxDocument
Dim pPoint1 As IPoint
Dim pPoint2 As IPoint
Dim pFeatureLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
Dim pFeature1 As IFeature
Dim pFeatureCursor1 As IFeatureCursor
Dim pFeature2 As IFeature
Dim pFeatureCursor2 As IFeatureCursor
'Dim x1, y1, x2, y2, d As Double
Dim pTable As ITable
Dim pRow As IRow
Dim pFeatureWorkspace As IFeatureWorkspace
Dim pWorkspace As IWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pFieldsEdit As IFieldsEdit
Dim pFields As IFields
Dim pLineFeatureClass As IFeatureClass
Dim pLineLayer As IFeatureLayer
Dim strPathTable As String
Dim strNameTable As String
'set general variables
Set pMxApplication = Application
Set pMxDocument = ThisDocument
'get the line and point feature classes
Set pFeatureLayer = pMxDocument.FocusMap.Layer(0)
Set pFeatureClass = pFeatureLayer.FeatureClass
Set pLineLayer = pMxDocument.FocusMap.Layer(1)
Set pLineFeatureClass = pLineLayer.FeatureClass
'point feature class has to be the first layer on TOC
If pFeatureClass.ShapeType <> esriGeometryPoint Then
MsgBox "Input Point Feature Class has to be the first layer on TOC"
Exit Sub
End If
'line feature class has to be the first layer on TOC
If pLineFeatureClass.ShapeType <> esriGeometryPolyline Then
MsgBox "Output Line Feature Class has to be the first layer on TOC"
Exit Sub
End If
'ask for the name (strNameTable) and the path of the point-point table (strPathTable)
strPathTable = InputBox("Insert Table's Path:", "Table's Path", "c:\temp")
strNameTable = InputBox("Insert Table's Name:", "Table's Name: *.dbf", "point_point")
'to write the table it will be used a SWF (dbf table)
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pWorkspace = pWorkspaceFactory.OpenFromFile(strPathTable, 0)
Set pFeatureWorkspace = pWorkspace
'this will add the table's fields
Dim pFieldOggetto As IFieldEdit
Set pFieldOggetto = New Field
With pFieldOggetto
.Type = esriFieldTypeString
.Name = "POINT"
.Length = 20
End With
Set pFieldsEdit = New Fields
pFieldsEdit.AddField pFieldOggetto
Set pFields = pFieldsEdit
Set pTable = pFeatureWorkspace.CreateTable(strNameTable, pFields, Nothing, Nothing, "")
'loop to add a field for every point
Set pFeatureCursor1 = pFeatureClass.Search(Nothing, False)
Set pFeature1 = pFeatureCursor1.NextFeature
Dim i As Integer
i = 0
Do Until pFeature1 Is Nothing
Dim pField As IFieldEdit
Set pField = New Field
With pField
.Type = esriFieldTypeDouble
.Name = "POINT_" & i
pTable.AddField pField
End With
i = i + 1
Set pFeature1 = pFeatureCursor1.NextFeature
Loop
'here is the main
Set pFeatureCursor1 = pFeatureClass.Search(Nothing, False)
Set pFeature1 = pFeatureCursor1.NextFeature
i = 0
Dim j As Integer
'we are on the first row
Do Until pFeature1 Is Nothing
j = 0
Set pRow = pTable.CreateRow
pRow.Value(pTable.FindField("POINT")) = "POINT_" & i
pRow.Store
Set pFeatureCursor2 = pFeatureClass.Search(Nothing, False)
Set pFeature2 = pFeatureCursor2.NextFeature
Do Until pFeature2 Is Nothing
'distance's calculation
'Set pPoint1 = pFeature1.Shape
'Set pPoint2 = pFeature2.Shape
'x1 = pPoint1.X
'y1 = pPoint1.Y
'x2 = pPoint2.X
'y2 = pPoint2.Y
'd = (((x2 - x1) ^ 2) + ((y2 - y1) ^ 2)) ^ 0.5
'here we create the polyline between pPoint1 e pPoint2
'If (j >= (i + 1)) Then 'to make sure not to have zero length line and 2 lines for 2 points
'Dim pPolyline As IPolyline
'Set pPolyline = New Polyline
'pPolyline.FromPoint = pPoint1
'pPolyline.ToPoint = pPoint2
'Dim pLineFeature As IFeature
'Set pLineFeature = pLineFeatureClass.CreateFeature
'Set pLineFeature.Shape = pPolyline
'pLineFeature.Store
'End If
'here it should start the code that i need
if point1 is connected to point2
pRow.Value(pTable.FindField("POINT_" & j)) = 1
else
pRow.Value(pTable.FindField("POINT_" & j)) = 0
pRow.Store
j = j + 1
Set pFeature2 = pFeatureCursor2.NextFeature
Loop
i = i + 1
Set pFeature1 = pFeatureCursor1.NextFeature
Loop
pMxDocument.ActiveView.Refresh
End Sub
|
