Shapefile polygon feature won't delete properly

MatthewBuchanan — Sun, 12 Dec 2021 16:15:45 GMT

Hi
I'm trying to cut a shapefile that has one polygon in it, with a line from another shapefile. The actual cutting of the polygon and creating of two new polygons seems to work fine, but then I want to delete the original polygon so there should be only 2 polygons, but the original is still there. The attribute table shows 3 but only 2 are showing when it draws.

See the bold section in the code below. Am I missing something? I also tried this code to delete the original polygon:

            Using comReleaser As ComReleaser = New ComReleaser
                Dim newFeatCurs As IFeatureCursor = polyFtrClass.Search(qryFilter, False) '.Update(qryFilter, False)
                comReleaser.ManageLifetime(newFeatCurs)
                Dim delFeature As IFeature = newFeatCurs.NextFeature
                Do While Not delFeature Is Nothing
                    delFeature.Delete()
                    delFeature = newFeatCurs.NextFeature
                Loop
                newFeatCurs = Nothing
            End Using

I'm using ArcMap 9.3.1 SP2, and programming in VB.NET (Visual Studio 2005.)

    
Public Sub cutty(ByVal app As IApplication)
        Debug.Print("cutty")

        ' Add layers to map
        Dim mxDoc As IMxDocument = app.Document
        Dim map As IMap = mxDoc.FocusMap
        Dim lyr As ILayer
        Dim strInputLayer As String = "test_polygon"
        Dim strCopy As String = "test_manipulate"
        Dim ftrlyr As IFeatureLayer = New FeatureLayer
        Dim featClass As IFeatureClass
        Dim ds As IDataset = Nothing
        ' delete output layer from map if it's there
        ' get input layer from TOC
        Dim i As Integer
        For i = map.LayerCount - 1 To 0 Step -1
            lyr = map.Layer(i)
            If UCase(lyr.Name) = UCase(strCopy) Then
                map.DeleteLayer(lyr)
            ElseIf UCase(lyr.Name) = UCase(strInputLayer) Then
                ftrlyr = lyr
                featClass = ftrlyr.FeatureClass
                ds = featClass
            End If
        Next i

        Dim wkspcFactory As IWorkspaceFactory = New ShapefileWorkspaceFactory()
        Dim inWorkspace As IWorkspace = ds.Workspace
        Dim featWorkspace As IFeatureWorkspace = inWorkspace
        Dim ftrlyrCopy As IFeatureLayer = New FeatureLayer
        If ds.CanCopy Then
            Try
                Dim featClass2 As IFeatureClass = featWorkspace.OpenFeatureClass(strCopy)
                Debug.Print("trying to open: " & strCopy)
                Dim ds2 As IDataset = featClass2
                ds2.Delete()
                Debug.Print("Deleted: " & strCopy)
            Catch ex As Exception
                Debug.Print("FAILED TO DELETE")
            End Try
            ds.Copy(strCopy, inWorkspace)
            ftrlyrCopy.FeatureClass = featWorkspace.OpenFeatureClass(strCopy)
            ftrlyrCopy.Name = strCopy
            mxDoc.AddLayer(ftrlyrCopy)
        End If
        mxDoc.UpdateContents()
        mxDoc.ActiveView.Refresh()
        Debug.Print("DONE")

        ' CUT PART
        Try
            ' Setup
            Debug.Print("* cutty  ************************************")

            ' HARDCODED -----------------------------------
            Dim strCutline As String = "test_cutline"
            Dim strfootprint As String = strCopy
            Dim crestFtrLyr As IFeatureLayer = New FeatureLayer
            Dim crestFtrClass As IFeatureClass = featWorkspace.OpenFeatureClass(strCutline)
            '----------------------------------------------
            ' Get dam crest layer i.e. cutting line
            ' COMMENTED OUT FOR TESTING
            'Dim crestFtrLyr As IFeatureLayer = GetLayerByName(strCutline)
            'Dim crestFtrClass As IFeatureClass = crestFtrLyr.FeatureClass

            ' Select the right side dam crest (positive direction)
            Debug.Print("  Select right side dam crest")
            Dim qryFilter As IQueryFilter = New QueryFilter()
            qryFilter.WhereClause = "Comment = 'crestedge-pos'"
            Dim crestFeatCurs As IFeatureCursor = crestFtrClass.Update(qryFilter, False)
            Dim crestFeature As IFeature = crestFeatCurs.NextFeature()
            Dim pCutLineLeft As IPolyline
            Dim pCutLineRight As IPolyline
            pCutLineRight = crestFeature.Shape
            ' Now the left crest (negative direction)
            Debug.Print("  Select left side dam crest")
            qryFilter.WhereClause = "Comment = 'crestedge-neg'"
            crestFeatCurs = crestFtrClass.Update(qryFilter, False)
            crestFeature = crestFeatCurs.NextFeature()
            pCutLineLeft = crestFeature.Shape
            crestFeature = Nothing
            crestFeatCurs = Nothing

            ' Get polygon footprint
            Debug.Print("  poly footprint")
            Dim polyFtrLyr As IFeatureLayer = GetLayerByName(strfootprint)
            Dim polyFtrClass As IFeatureClass = polyFtrLyr.FeatureClass

            '================================================================
            ' Use dam crest to cut footprint poly into 3 features
            ' First cut the polygon into 2 pieces with the right cutting line
            Debug.Print("  Part 1 Now make new right")
            Dim pSF As ISpatialFilter = New SpatialFilter()
            pSF.Geometry = pCutLineRight
            pSF.GeometryField = "Shape"
            pSF.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
            Dim polyFeatCurs As IFeatureCursor
            polyFeatCurs = CType(polyFtrClass.Update(pSF, False), IFeatureCursor)
            Dim polyFeature As IFeature = polyFeatCurs.NextFeature()
            Dim origPolygon As IPolygon = polyFeature.ShapeCopy 'Shape or ShapeCopy ?????
            ' note: ITopologicalOperator5 gives an error
            Dim pTopoOper As ITopologicalOperator4 = Nothing
            pTopoOper = origPolygon
            Dim pLGeom As IPolygon = Nothing
            Dim pRGeom As IPolygon = Nothing
            pTopoOper.Cut(pCutLineRight, pLGeom, pRGeom)

            ' Make a new right poly
            polyFeatCurs = polyFtrClass.Insert(True)
            Dim polyFeatBuf As IFeatureBuffer
            polyFeatBuf = polyFtrClass.CreateFeatureBuffer
            polyFeatBuf.Shape = pRGeom
            polyFeatBuf.Value(polyFeatBuf.Fields.FindField("Comment")) = "RIGHT"
            Dim pArea As IArea = pRGeom
            polyFeatBuf.Value(polyFeatBuf.Fields.FindField("Area")) = pArea.Area
            polyFeatCurs.InsertFeature(polyFeatBuf)
            'polyFeatCurs.Flush()
            polyFeatCurs = Nothing

            ' Make a new left poly
            polyFeatCurs = polyFtrClass.Insert(True)
            polyFeatBuf = polyFtrClass.CreateFeatureBuffer
            polyFeatBuf.Shape = pLGeom
            polyFeatBuf.Value(polyFeatBuf.Fields.FindField("Comment")) = "LEFT"
            pArea = pLGeom
            polyFeatBuf.Value(polyFeatBuf.Fields.FindField("Area")) = pArea.Area
            polyFeatCurs.InsertFeature(polyFeatBuf)
            polyFeatCurs.Flush()
            polyFeatCurs = Nothing
            polyFeatBuf = Nothing

            ' delete original polygon
            Debug.Print("  ----delete original----")
            qryFilter.WhereClause = "Comment = 'FOOTPRINT'"
            Dim table As ITable = CType(polyFtrClass, ITable)
            table.DeleteSearchedRows(qryFilter)
            table = Nothing

            ' There should be two records, but the original polygon is still there.
            Debug.Print("  Number of records = " & polyFtrClass.FeatureCount(Nothing))

            ' Refresh view
            mxDoc.ActiveView.Refresh()
            MessageBox.Show("Finished")

        Catch ex As Exception
            Debug.Print("--EXCEPTION HAS OCCURRED IN cutty-")
            Debug.Print(ex.Message)
            MessageBox.Show("Error #" & Information.Err().Number & Environment.NewLine & Information.Err().Description & Environment.NewLine & Information.Err().Source, "cutty", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

    End Sub

Re: Shapefile polygon feature won't delete properly

MatthewBuchanan — Mon, 17 Jan 2011 15:35:40 GMT

I got around this problem by setting the new cut geometry back to the original polygon so that I didn't have to do any deleting of records.

I'm not sure why deleting of records is such a problem. Hopefully Arc10 will be better.

topic Re: Shapefile polygon feature won't delete properly in ArcObjects SDK Questions

Shapefile polygon feature won't delete properly

Re: Shapefile polygon feature won't delete properly