Hi,The error type mismatch was due to the line Set pFLayer = pMxDoc.FocusMap.Layer(0)
as the selected layer was a point and the help for "IPointCollection" specifically mentions that Its used to access and manipulate the Points in Multipoints, Paths, Rings,
Polylines, Polygons, Triangles, TriangleFans, TriangleStrips, and MultiPatches
But still its not selecting any layer and returning an error that:Item not found in this collection
In code mentioned below: Public Sub a()
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pFLayer As IFeatureLayer
Set pFLayer = pMxDoc.FocusMap.Layer(1)
Dim pDS As IDataset
Set pDS = pFLayer
Dim pFWS As IFeatureWorkspace
Set pFWS = pDS.Workspace
Dim pFields As IFields
Dim pFieldsEdit As IFieldsEdit
Set pFields = New esriGeoDatabase.Fields
Set pFieldsEdit = pFields
Dim pField As IField
Dim pFieldEdit As IFieldEdit
Set pField = New esriGeoDatabase.Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 10
.Name = "PolylineID"
.Type = 1
End With
pFieldsEdit.AddField pField
Set pField = New esriGeoDatabase.Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 10
.Name = "VertexID"
.Type = 1
End With
pFieldsEdit.AddField pField
Set pField = New esriGeoDatabase.Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 20
.Name = "X_Vertex"
.Type = esriFieldTypeDouble
End With
pFieldsEdit.AddField pField
Set pField = New esriGeoDatabase.Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 20
.Name = "Y_Vertex"
.Type = esriFieldTypeDouble
End With
pFieldsEdit.AddField pField
Dim pTable As ITable
Dim pTmpDS As IDataset
Dim pEnumDS As IEnumDataset
Dim pWS As IWorkspace
Set pWS = pFWS
Set pEnumDS = pWS.Datasets(esriDTTable)
Set pTmpDS = pEnumDS.Next
Do Until pTmpDS Is Nothing
If pTmpDS.Name = "output" Then
pTmpDS.Delete
Exit Do
End If
Set pTmpDS = pEnumDS.Next
Loop
Set pTable = pFWS.CreateTable("output", pFields, Nothing, Nothing, "")
Dim pFClass As IFeatureClass
Set pFClass = pFLayer.FeatureClass
Dim pFC As IFeatureCursor
Set pFC = pFClass.Search(Nothing, False)
Dim pF As IFeature
Set pF = pFC.NextFeature
Do Until pF Is Nothing
Dim pPC As IPointCollection
Set pPC = pF.Shape
Dim i As Integer
i = 1
Dim x As Integer
For x = 0 To pPC.PointCount - 1
Dim pRow As IRow
Set pRow = pTable.CreateRow
pRow.Value(3) = pPC.Point(x).x
pRow.Value(4) = pPC.Point(x).Y
pRow.Value(2) = i
pRow.Value(1) = pF.OID
pRow.Store
i = i + 1
Next x
Set pF = pFC.NextFeature
Loop
End Sub
Please help as i'll be very thankful.