如何分割一个地物？

<P>如何分割一个地物？就是用MAPCONTROL编程实现分割线、面。</P>

<PRE>Private Function SplitFeature(ByRef pSplitFeature As IFeature, pSplitPoint As IPoint) As Boolean
  On Error GoTo ErrorHandler
    Dim pPolyCurve As IPolycurve2
    Dim pGeoColl As IGeometryCollection
    Dim pNewFeature As IFeature
    Dim PartCount As Integer
    Dim pTempFeature As IFeature
    Dim pEditLayers As IEditLayers
    Dim fldName As String
    Dim iFieldIndx As Long

'get length_miles field and fieldindex
673:             fldName = ProfileGetItem("PRIMARYFIELDS", "LENGTH_MILES", "", "C:\PDCustom\Data.ini")

    
677:     Set pEditLayers = m_pEditor
678:     m_pEditor.StartOperation
'Split the found features, each split makes a new part
    Dim bSplit As Boolean, lPart As Long, lSeg As Long
681:     Set pPolyCurve = pSplitFeature.Shape
682:     Set pGeoColl = pPolyCurve
683:     pPolyCurve.SplitAtPoint pSplitPoint, False, True, bSplit, lPart, lSeg

685: If bSplit = True Then
686:     bSplitDone = True


689:     Set pTempFeature = pEditLayers.CurrentLayer.FeatureClass.CreateFeature
690:     CopyAttributes pSplitFeature, pTempFeature
691:     pSplitFeature.Delete
692:    For PartCount = 0 To pGeoColl.GeometryCount - 1
693:         Set pNewFeature = pEditLayers.CurrentLayer.FeatureClass.CreateFeature
694:         Set pNewFeature.Shape = BUILDPOLYLINE(pGeoColl.Geometry(PartCount))
'get field index of length_miles field
696:             iFieldIndx = pNewFeature.Fields.FindField(fldName)
697:         If PartCount = 1 Then
698:            CopyAttributes pTempFeature, pNewFeature

'to number the new sectionnum  dated mar 6 2003
701:            If UCase(g_GridCondition) = UCase("true") Then
702:                    FindGridNum pSplitPoint
'to get new sectionum
704:                    GetMax_NumNUpdateIDTable "PRIMARY", grid_num, frmPrimary.txtSectionNum, frmPole.txtPlotNo, False, 0
'to update new sectionum
706:                    GetMax_NumNUpdateIDTable "PRIMARY", grid_num, frmPrimary.txtSectionNum, frmPole.txtPlotNo, True, 0
707:                    pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM")) = Trim(frmPrimary.txtSectionNum)
708:             ElseIf UCase(g_SEQentialCondition) = UCase("true") Then
'to get new sectionnnum
710:                    GetMax_NumNUpdateIDTable "PRIMARY", "", frmPrimary.txtSectionNum, frmPole.txtPlotNo, False, 0
'to update new sectionnum
712:                    GetMax_NumNUpdateIDTable "PRIMARY", "", frmPrimary.txtSectionNum, frmPole.txtPlotNo, True, 0
713:                    pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM")) = Trim(frmPrimary.txtSectionNum)
714:             Else
715:                    pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM")) = pNewFeature.OID
716:             End If
717:            g_SplitNewSectionNum = pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM"))
718:            WriteValuesIntoIniFile "C:\PDCustom\CustomSettings.ini", "DeviceTask", "SPLITNEWSECTIONNUM", pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM"))
719:            pNewFeature.Value(pNewFeature.Fields.FindField("UPSECTION")) = pTempFeature.Value(pTempFeature.Fields.FindField("SECTIONNUM"))
720:            pNewFeature.Value(pNewFeature.Fields.FindField("EDITDATE")) = Now
'this is for updatine upsectionvalues for the related records
722:            pNewSectionNum = pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM"))
723:            pOldSectionNum = pNewFeature.Value(pNewFeature.Fields.FindField("UPSECTION"))
724:            pNewOID = pNewFeature.OID
725:             If iFieldIndx <> -1 Then
726:             If pNewFeature.Fields.FindField("SHAPE_LENGTH") <> -1 Then
727:                pNewFeature.Value(pNewFeature.Fields.FindField("LENGTH_MILES")) = pNewFeature.Value(pNewFeature.Fields.FindField("SHAPE_LENGTH")) / 5280
728:             ElseIf pNewFeature.Fields.FindField("SHAPE.LEN") <> -1 Then
729:                pNewFeature.Value(pNewFeature.Fields.FindField("LENGTH_MILES")) = pNewFeature.Value(pNewFeature.Fields.FindField("SHAPE.LEN")) / 5280
730:             End If
731:             End If
732:         End If
733:         If PartCount = 0 Then
734:             CopyAttributes pTempFeature, pNewFeature
735:             pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM")) = pTempFeature.Value(pTempFeature.Fields.FindField("SECTIONNUM"))
736:             g_SplitOldSectionNum = pTempFeature.Value(pTempFeature.Fields.FindField("SECTIONNUM"))
737:             WriteValuesIntoIniFile "C:\PDCustom\CustomSettings.ini", "DeviceTask", "SPLITOLDSECTIONNUM", pTempFeature.Value(pTempFeature.Fields.FindField("SECTIONNUM"))
738:             pNewFeature.Value(pNewFeature.Fields.FindField("EDITDATE")) = Now
739:             If iFieldIndx <> -1 Then
740:             If pNewFeature.Fields.FindField("SHAPE_LENGTH") <> -1 Then
741:                pNewFeature.Value(pNewFeature.Fields.FindField("LENGTH_MILES")) = pNewFeature.Value(pNewFeature.Fields.FindField("SHAPE_LENGTH")) / 5280
742:             ElseIf pNewFeature.Fields.FindField("SHAPE.LEN") <> -1 Then
743:                pNewFeature.Value(pNewFeature.Fields.FindField("LENGTH_MILES")) = pNewFeature.Value(pNewFeature.Fields.FindField("SHAPE.LEN")) / 5280
744:             End If
745:             End If
746:         End If

'BEFORE STORING CHECK FOR DUPLICATES
749: If CheckDuplicates("SECTIONNUM", pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM"))) = True Then
750:          MsgBox "Duplicate Sectionnum(s) found. " ; Chr(13) ; "Duplicates must be corrected for editing ." ; Chr(13) ; "Sectionnum:=:" ; pNewFeature.Value(pNewFeature.Fields.FindField("SECTIONNUM")), vbCritical + vbInformation, "Duplicate Found in  Split Primary Line Section"
751:          SplitFeature = False
752:          m_pEditor.AbortOperation
753:          GoTo ClearVariables
754:     Else
755:          SplitFeature = True
756: End If

758:   pNewFeature.Store
759:   Next PartCount
760:   pTempFeature.Delete

762:   MsgBox "Split done successfully", vbInformation, "Split Primary Line Section"

764: End If

'Error line ..............//it works great in Perosnal Geodatabase ...and also the line is partcipating in Geometric Network
766:   m_pEditor.StopOperation ("Custom Splits")


ClearVariables:
768: Set pEditLayers = Nothing
769: Set pPolyCurve = Nothing
770: Set pGeoColl = Nothing
771: Set pTempFeature = Nothing
772: Set pNewFeature = Nothing

Exit Function
ErrorHandler:
  HandleError False, "SplitFeature " ; c_sModuleFileName ; " " ; GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Function
</PRE>

Public Function GetFeatureFromEID(theEID As Long, elType As esriElementType, pGeomNet As IGeometricNetwork) As IFeature<BR>'This function returns an IFeature object pointing to the feature with the given EID<BR>    <BR>  'assign the logical network to the INetwork variable<BR>  Dim pNetwork As INetwork<BR>  Set pNetwork = pGeomNet.Network<BR>  <BR>  'Get the user and class ID for the given EID<BR>  Dim pNetElements As INetElements<BR>  Set pNetElements = pNetwork 'QI<BR>  Dim lClassID As Long, lUserID As Long, lUserSubID As Long<BR>  pNetElements.QueryIDs theEID, elType, lClassID, lUserID, lUserSubID<BR><BR>  'Get the feature class from the network, and return the feature with the lUserID<BR>  Dim pFClass As IFeatureClass<BR>  Dim pFeat As IFeature<BR>  Dim pFClasses As IEnumFeatureClass<BR>  If elType = esriETEdge Then<BR>    'Check the complex edges<BR>    Set pFClasses = pGeomNet.ClassesByType(esriFTComplexEdge)<BR>    pFClasses.Reset<BR>    Set pFClass = pFClasses.Next<BR>    Do Until pFClass Is Nothing<BR>      If pFClass.ObjectClassID = lClassID Then<BR>        Set pFeat = pFClass.GetFeature(lUserID)<BR>        Set GetFeatureFromEID = pFeat<BR>        Exit Function<BR>      End If<BR>      Set pFClass = pFClasses.Next<BR>    Loop<BR>    'Check the simple edges<BR>    Set pFClasses = pGeomNet.ClassesByType(esriFTSimpleEdge)<BR>    pFClasses.Reset<BR>    Set pFClass = pFClasses.Next<BR>    Do Until pFClass Is Nothing<BR>      If pFClass.ObjectClassID = lClassID Then<BR>        Set pFeat = pFClass.GetFeature(lUserID)<BR>        Set GetFeatureFromEID = pFeat<BR>        Exit Function<BR>      End If<BR>      Set pFClass = pFClasses.Next<BR>    Loop<BR>  ElseIf elType = esriETJunction Then<BR>    'Check the simple junctions<BR>    Set pFClasses = pGeomNet.ClassesByType(esriFTSimpleJunction)<BR>    pFClasses.Reset<BR>    Set pFClass = pFClasses.Next<BR>    Do Until pFClass Is Nothing<BR>      If pFClass.ObjectClassID = lClassID Then<BR>        Set pFeat = pFClass.GetFeature(lUserID)<BR>        Set GetFeatureFromEID = pFeat<BR>        Exit Function<BR>      End If<BR>      Set pFClass = pFClasses.Next<BR>    Loop<BR>    'Check the complex junctions<BR>    Set pFClasses = pGeomNet.ClassesByType(esriFTComplexJunction)<BR>    pFClasses.Reset<BR>    Set pFClass = pFClasses.Next<BR>    Do Until pFClass Is Nothing<BR>      If pFClass.ObjectClassID = lClassID Then<BR>        Set pFeat = pFClass.GetFeature(lUserID)<BR>        Set GetFeatureFromEID = pFeat<BR>        Exit Function<BR>      End If<BR>      Set pFClass = pFClasses.Next<BR>    Loop<BR>  End If<BR>End function<BR><BR>Private Sub SplitFeature(pFeature As IFeature, pSplitPoint As IPoint)<BR>  On Error GoTo ErrorHandler<BR>  <BR>  Dim pPolyCurve As IPolycurve2<BR>  Dim pGeoColl As iGeometryCollection<BR>  Dim pNewFeature As IFeature<BR>  Dim PartCount As Integer<BR>  <BR>  'Split the found features, each split makes a new part<BR>  Dim bSplit As Boolean, lPart As Long, lSeg As Long<BR>  Set pPolyCurve = pFeature.Shape<BR>  pPolyCurve.SplitAtPoint pSplitPoint, False, True, bSplit, lPart, lSeg<BR><BR>  Set pGeoColl = pPolyCurve<BR>  Dim pFClass As IFeatureClass<BR>  Set pFClass = pFeature.Class<BR>  For PartCount = 0 To pGeoColl.GeometryCount - 1<BR>    Set pNewFeature = pFClass.CreateFeature<BR>    Set pNewFeature.Shape = BUILDPOLYLINE(pGeoColl.Geometry(PartCount))<BR>    COPYATTRIBUTES pFeature, pNewFeature<BR>    pNewFeature.Store<BR>  Next PartCount<BR>  <BR>  'Delete the original feature<BR>  pFeature.Delete<BR>  <BR>  Exit Sub<BR><BR>ErrorHandler:<BR>  MsgBox "Error " ; Err.Number ; ": " ; Err.Description ; vbNewLine _<BR>       ; "In " ; Err.Source ; " at Function SplitFeature"<BR>End Sub<BR><BR>Private Sub COPYATTRIBUTES(pSourceFeature As IFeature, pDestinationFeature As IFeature)<BR>  On Error GoTo ErrorHandler<BR>  <BR>  Dim pField As IField<BR>  Dim pFields As IFields<BR>  Dim pRow As IRow<BR>  Dim FieldCount As Integer<BR>  <BR>  Set pFields = pSourceFeature.Fields<BR>  For FieldCount = 0 To pFields.FieldCount - 1<BR>    Set pField = pFields.Field(FieldCount)<BR>    If pField.Editable Then<BR>      If Not pField.Type = esriFieldTypeOID And Not pField.Type = esriFieldTypeGeometry Then<BR>        pDestinationFeature.Value(FieldCount) = pSourceFeature.Value(FieldCount)<BR>      End If<BR>    End If<BR>  Next<BR>  <BR>  Exit Sub<BR><BR>ErrorHandler:<BR>  MsgBox "Error " ; Err.Number ; ": " ; Err.Description ; vbNewLine _<BR>       ; "In " ; Err.Source ; " at SplitLineAtMidPoint.COPYATTRIBUTES"<BR>End Sub<BR><BR>Private Function BUILDPOLYLINE(pSegColl As ISegmentCollection) As IPolyline<BR>  On Error GoTo ErrorHandler<BR>  <BR>  Dim pPolyline As iGeometryCollection<BR>  Set pPolyline = New Polyline<BR>  pPolyline.AddGeometries 1, pSegColl<BR>  Set BUILDPOLYLINE = pPolyline<BR>  <BR>  Exit Function<BR><BR>ErrorHandler:<BR>  MsgBox "Error " ; Err.Number ; ": " ; Err.Description ; vbNewLine _<BR>       ; "In " ; Err.Source ; " at SplitLineAtMidPoint.BUILDPOLYLINE"<BR>End Function<BR>