Hi all,
I am attempting to create a collection of IFeature objects based on whether or not they fail a test so that I can add them into a new featureclass (as a kind of error report - if there is a better way to accomplish this then please please please let me know). I use a featurecursor to test each feature for geometry and attribute matches and then if they fail I add them to an ISet (pSet.Add(pFtr)). The problem is that when I do this instead of adding the erroneous features it adds ONLY the final feature in the test feature set. I have not been able to find any information about this which makes me think, a.) This is a random one off bug or b.) There is a much better way to do this. Can anyone please tell me where I am going wrong with this?
Thanks in advance
I am attempting to create a collection of IFeature objects based on whether or not they fail a test so that I can add them into a new featureclass (as a kind of error report - if there is a better way to accomplish this then please please please let me know). I use a featurecursor to test each feature for geometry and attribute matches and then if they fail I add them to an ISet (pSet.Add(pFtr)). The problem is that when I do this instead of adding the erroneous features it adds ONLY the final feature in the test feature set. I have not been able to find any information about this which makes me think, a.) This is a random one off bug or b.) There is a much better way to do this. Can anyone please tell me where I am going wrong with this?
Thanks in advance
Code:
Private Sub RunCompareTool(ByVal basefeaturelayer As IFeatureLayer, ByVal testfeaturelayer As IFeatureLayer)
' This sub checks that each feature in the test layer exists within
' the the base layer.
Try
'First Test that the geometry type is the same
If Not basefeaturelayer.FeatureClass.ShapeType = testfeaturelayer.FeatureClass.ShapeType Then
MsgBox("Geometry types do not match and therefore cannot be compared." & vbNewLine & "Aborting...", MsgBoxStyle.Critical, "Geometry mismatch")
Exit Sub
End If
'Next test that features exist in both layers
If basefeaturelayer.FeatureClass.FeatureCount(Nothing) = 0 Then
MsgBox(basefeaturelayer.Name & " contains no features." & vbNewLine & "Aborting...", MsgBoxStyle.Critical, "Empty layer")
Exit Sub
End If
If testfeaturelayer.FeatureClass.FeatureCount(Nothing) = 0 Then
MsgBox(testfeaturelayer.Name & " contains no features." & vbNewLine & "Aborting...", MsgBoxStyle.Critical, "Empty layer")
Exit Sub
End If
' Get sub selection from base layer based on test layer extent and add to featurecursor
g_pMap.ClearSelection()
Dim psf As ISpatialFilter = New SpatialFilter
With psf
.Geometry = testfeaturelayer.AreaOfInterest
.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
End With
Dim basesel As IFeatureSelection = basefeaturelayer
basesel.SelectFeatures(psf, esriSelectionResultEnum.esriSelectionResultNew, False)
Dim basecursor As IFeatureCursor
basesel.SelectionSet.Search(Nothing, True, basecursor)
' Get feature cursor on all features in test layer
Dim testcursor As IFeatureCursor = testfeaturelayer.Search(Nothing, True)
' Use iteration through the tow featurecursors to compare all features within the
' test layer with the baselayer and use the results to flick a boolean switch if a
' match is found.
Dim pRelOp As IRelationalOperator
Dim basefeat As IFeature = basecursor.NextFeature
Dim testfeat As IFeature = testcursor.NextFeature
Dim layermatch As Boolean = True
Dim geommatch, attributematch As String
Dim workspacetype As Integer = GetWorkspaceType(testfeaturelayer)
Dim errorbag As IGeometryCollection = New GeometryBag
Dim errorset As ISet = New [Set]
Do While Not testfeat Is Nothing
geommatch = "Failed"
attributematch = "Not Tested"
pRelOp = testfeat.Shape 'Set IRelationalOperator to test geometry
'Reset base layer cursor
basesel.SelectionSet.Search(Nothing, True, basecursor)
basefeat = basecursor.NextFeature
Do While Not basefeat Is Nothing
' Use IRelationalOperator to test the shape of the test feature for a match in
' the selected base layer
If pRelOp.Equals(basefeat.Shape) Then
geommatch = "Passed"
'If selected then check this features attributes
If cbbTestType.SelectedIndex = 1 Then
If CompareFieldData(basefeat, testfeat, workspacetype) Then
attributematch = "Passed"
Exit Do
Else
attributematch = "Failed"
End If
End If
Exit Do
End If
basefeat = basecursor.NextFeature
Loop
If geommatch = "Failed" Or attributematch = "Failed" Then
layermatch = False
If chbProduceErrorLayer.Checked Then
MsgBox(testfeat.Value(3) & vbNewLine & testfeat.OID) '+++ Confirm that the features are the ones that failed the test.
errorset.Add(testfeat) '+++ These features in my test space (TestFeatureLayer) are OID 11 and 58.
errorbag.AddGeometry(testfeat.ShapeCopy)
Else
'If no feature error record is being kept then exit loop and report layer match as false
Exit Do
End If
End If
testfeat = testcursor.NextFeature
Loop
If Not errorbag.GeometryCount = 0 Then InsertFeatures(errorbag)
'++++ This returns only the last feature from TestFeatureLayer, OID 153
errorset.Reset()
Dim test As IFeature = errorset.Next
Do While Not test Is Nothing
MsgBox(test.Value(3) & vbNewLine & test.OID)
test = errorset.Next
Loop
If layermatch = False Then
MsgBox("TEST FAILED: Not all of the test layer features and/or attributes were" & vbNewLine & "found within the base layer :-(", MsgBoxStyle.Information, "Results")
Else
MsgBox("TEST SUCEEDED: All of the test layer features and/or attributes were" & vbNewLine & "found within the base layer :-)", MsgBoxStyle.Information, "Results")
End If
Catch ex As Exception
MsgBox("RunCompareTool - " & ex.Message & vbNewLine & ex.StackTrace)
Finally
g_pMap.ClearSelection()
g_pMxDoc.UpdateContents()
g_pMxDoc.ActiveView.Refresh()
End Try
End Sub