niboac

pFeatureEdit.Split(pPoint),split error:The operation was attempted on an empty geomet

Discussion created by niboac on Apr 22, 2010
Latest reply on Apr 26, 2010 by niboac
I want to split polylines at intersection??and I have code in arcmap using VBA??I know that the function split will delete the old polyline and create 2 new polylines ??but when I split again??it return error?????The operation was attempted on an empty geometry?????I know it because the old polyline has been deleted??but how can I refresh the features and let it can't include the polyline that has been deleted???my code??


Option Explicit
Public ci As Long

Sub daduan()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument 'Application.Document
    Dim pLayerPoint As IFeatureLayer, pLayerPolyg As IFeatureLayer
    Set pLayerPoint = pMxDoc.FocusMap.Layer(0)
    Set pLayerPolyg = pMxDoc.FocusMap.Layer(0)
   
    Dim pDatasetPolyg As IDataset
    Set pDatasetPolyg = pLayerPolyg.FeatureClass
    Dim pScratchWorkspace As IWorkspace
    Set pScratchWorkspace = pDatasetPolyg.Workspace
    Dim pTopoOptr As ITopologicalOperator
    Dim pGeomColl As IGeometryCollection
    Dim pPCol As IPointCollection
    Set pPCol = New Multipoint
   
 
    Dim Count As Integer
      
    Dim pSplitPline1 As IPolyline
    Dim pSplitPline2 As IPolyline
    Dim pSelectionSet As ISelectionSet
   
    Dim pFeatureWorkspace As IFeatureWorkspace
    Dim pSpatialFilter As ISpatialFilter
   
    Dim pWorkspaceFactory As IWorkspaceFactory
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
  
    'Create a selectionSet of polygons over the points location
'    Dim pFsel As IFeatureSelection
'    Set pFsel = pLayerPoint
'    If pFsel.SelectionSet.Count < 1 Then
'      MsgBox "Select one or more lines from " & pLayerPoint.Name & ".", vbOKOnly, "Split at Specified Vertex"
'      Exit Sub
'    End If

    Set pSpatialFilter = New SpatialFilter
    With pSpatialFilter
        Set .Geometry = pLayerPoint.AreaOfInterest
        .SpatialRel = esriSpatialRelIntersects
    End With
    Set pSelectionSet = pLayerPolyg.FeatureClass.Select(pSpatialFilter, esriSelectionTypeHybrid, esriSelectionOptionNormal, pScratchWorkspace)

 
    'loop through points
    Dim pFeatCursorPoints As IFeatureCursor, pFeatCursorPolyg As IFeatureCursor
   

    Set pFeatCursorPoints = pLayerPoint.FeatureClass.Update(Nothing, False)
    Dim pFeat1 As IFeature, pFeat2 As IFeature
   
    Set pFeat1 = pFeatCursorPoints.NextFeature
  
    Do While Not pFeat1 Is Nothing
       
       
        Set pSpatialFilter = New SpatialFilter
        With pSpatialFilter
            Set .Geometry = pFeat1.Shape
            .SpatialRel = esriSpatialRelIntersects
        End With
        'search polygon
 
        pSelectionSet.Search pSpatialFilter, False, pFeatCursorPolyg
        'pFsel.SelectionSet.Search pSpatialFilter, False, pFeatCursorPolyg
        Set pFeat2 = pFeatCursorPolyg.NextFeature
        If Not pFeat2 Is Nothing Then
             Do While Not pFeat2 Is Nothing
              
                If (pFeat1.Value(2) = 420704 And pFeat2.Value(2) = 420601) Or _
                (pFeat1.Value(2) <> 420704 And pFeat1.Value(2) <> 420601 And pFeat2.Value(2) <> 420704) Or _
                (pFeat1.Value(2) = 420601 And pFeat2.Value(2) <> 420704 And pFeat2.Value(2) <> 420601) _
                Then
                    Set pTopoOptr = pFeat1.Shape
                    Set pGeomColl = pTopoOptr.Intersect(pFeat2.Shape, esriGeometry0Dimension)
                    'MsgBox (pGeomColl.GeometryCount)
                    'If no intersection points
                     If pGeomColl.GeometryCount > 0 Then
   
                        For Count = 0 To pGeomColl.GeometryCount - 1
                            Dim pPoint As IPoint
                            Set pPoint = pGeomColl.Geometry(Count)
                            'Split the feature
                           
                            Set pSplitPline1 = pFeat1.Shape
                            Set pSplitPline2 = pFeat2.Shape
                        
                            
                             If pPoint.Compare(pSplitPline1.FromPoint) <> 0 And pPoint.Compare(pSplitPline1.ToPoint) <> 0 Then
                                   
                                    pPCol.AddPoint pPoint
                                  
'                                    Dim pFeatureEdit As IFeatureEdit
'                                    Set pFeatureEdit = pFeat1
'                                    Dim pSplitSet As esriSystem.ISet
'                                    Set pSplitSet = pFeatureEdit.Split(pPoint)
                                    'pSplitSet.Reset
                                  
                               
                             End If
                           
                           Next Count
   
                        End If

                  
                    End If
   
                pFeatCursorPoints.UpdateFeature pFeat1
                Set pFeat2 = pFeatCursorPolyg.NextFeature
             Loop
        End If
        Set pFeat1 = pFeatCursorPoints.NextFeature
    Loop

    pMxDoc.ActiveView.Refresh
   

    Dim pPoint2 As IPoint
    If pPCol.PointCount > 0 Then
        For Count = 0 To pPCol.PointCount - 1
            Set pPoint2 = pPCol.Point(Count)
            Call SplitAll(pPoint2)
            pMxDoc.ActiveView.Refresh
       
        Next Count
    End If

    MsgBox ("pPCol.PointCount=" & pPCol.PointCount)
End Sub



Public Function SplitAll(pPoint As IPoint)
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
   
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap
   

    Dim pLineL As IFeatureLayer
    Set pLineL = pMap.Layer(0) 'line layer to be split
    pLineL.FeatureClass.Update Nothing, False
   
    Dim pLineFC As IFeatureClass
    Set pLineFC = pLineL.FeatureClass
    Dim pFeatureEdit As IFeatureEdit

    Dim pSet1 As esriSystem.ISet
    Dim pCompFeat1 As IFeature
    Dim pCompFeat2 As IFeature

              
        Dim pSF As ISpatialFilter
        Set pSF = New SpatialFilter
       
        With pSF
            Set .Geometry = pPoint
            .GeometryField = "Shape"
            .SpatialRel = esriSpatialRelIntersects
        End With
       
        Dim pLineCursor As IFeatureCursor
        Set pLineCursor = pLineFC.Search(pSF, True)
       
        Dim pLineF As IFeature
        pLineCursor.Flush

        Set pLineF = pLineCursor.NextFeature
       
        Dim pUID As New UID, pEditor As IEditor
        pUID.Value = "esriCore.Editor"
        Set pEditor = Application.FindExtensionByCLSID(pUID)
        If Not pEditor.EditState = esriStateEditing Then
          MsgBox "Start the Editor!", vbOKOnly, "Split at Specified Vertex"
          Exit Function
        End If
'        Dim Operation As Boolean
    
        Dim pInvalidArea As esriGeoDatabase.IInvalidArea
        Set pInvalidArea = New esriCarto.InvalidArea
        Set pInvalidArea.Display = pEditor.Display

      Do While Not pLineF Is Nothing
        If Not pLineF Is Nothing Then
            'On Error GoTo Err
            Dim pPolyCurve As IPolycurve
            Set pPolyCurve = pLineF.Shape
           
            Dim pToPoint As IPoint
            Set pToPoint = pPolyCurve.ToPoint
           
            Dim pFromPoint As IPoint
            Set pFromPoint = pPolyCurve.FromPoint
           
            If (pPoint.Compare(pFromPoint) <> 0 And pPoint.Compare(pToPoint) <> 0) Then
           
             
                Set pFeatureEdit = pLineF
                'pInvalidArea.Add pFeatureEdit
                'pEditor.StartOperation
              
                MsgBox (pLineF.Value(0))
                If pLineF.Shape.IsEmpty Then GoTo mn
                Set pSet1 = pFeatureEdit.Split(pPoint)
                pSet1.Reset
                Set pCompFeat1 = pSet1.Next
                Set pCompFeat2 = pSet1.Next
                Set pLineF = pCompFeat1
                pEditor.StopOperation "split"
                pLineL.FeatureClass.Update Nothing, False
               
                pInvalidArea.Invalidate esriAllScreenCaches
      
            End If
        End If
mn:     Set pLineF = pLineCursor.NextFeature
    Loop
       
        pLineCursor.Flush
      
'        pMxDoc.ActiveView.Refresh
   
   
End Function

Outcomes