HiI'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