Insert Features using Ifeatureclass.createFeaturebuffer method

Insert new Feature not using default built-in function..ESRI放出的例子

Completely show how to correctly insert features from InputFeatureclass to OutputFeatureClass 

 

Public Sub LoadFeatures()Sub LoadFeatures()
  Dim pInFeatureClass As IFeatureClass
  Dim pOutFeatureClass As IFeatureClass
  Dim pSearchFeatureCursor As IFeatureCursor
  Dim pFeature As IFeature
  Dim pInsertFeatureBuffer As IFeatureBuffer
  Dim pInsertFeatureCursor As IFeatureCursor
  Dim NewFeatureCount As Integer
  
  On Error GoTo ErrorHandler
  
  'Open shapefile where new features will be written to
  'For simplicity, sample does not contain code to create a new shapefile
  Set pOutFeatureClass = OpenFeatureClass("d:\data\usa", "test")
  If pOutFeatureClass Is Nothing Then Exit Sub
  Set pInsertFeatureCursor = pOutFeatureClass.Insert(True)
  Set pInsertFeatureBuffer = pOutFeatureClass.CreateFeatureBuffer
  
  'Open shapefile containing the features that will be copied
  Set pInFeatureClass = OpenFeatureClass("d:\data\usa", "counties")
  If pInFeatureClass Is Nothing Then Exit Sub

  'Loop through all the features in InFeatureClass
  Set pSearchFeatureCursor = pInFeatureClass.Search(Nothing, True)
  Set pFeature = pSearchFeatureCursor.NextFeature
  Do While Not pFeature Is Nothing
    'Add the original feature's geometry to the feature buffer
    Set pInsertFeatureBuffer.Shape = pFeature.Shape
    'Add all the original feature's fields to the feature buffer
    AddFields pInsertFeatureBuffer, pFeature
    'Insert the feature into the cursor
    pInsertFeatureCursor.InsertFeature pInsertFeatureBuffer
    NewFeatureCount = NewFeatureCount + 1
    'Flush the feature cursor every 100 features
    'This is safer because you can write code to handle a flush error
    'If you don't flush the feature cursor it will automatically flush but
    'after all of your code executes at which time you have no control
    If NewFeatureCount = 100 Then
      pInsertFeatureCursor.Flush
      NewFeatureCount = 0
    End If
    Set pFeature = pSearchFeatureCursor.NextFeature
  Loop
  pInsertFeatureCursor.Flush 'Flush the cursor one last time
  
  Exit Sub 'Exit to avoid error handler
  
ErrorHandler:
  MsgBox Err.Description
  Resume Next
End Sub

Private Sub AddFields()Sub AddFields(pFeatureBuffer As IFeatureBuffer, pFeature As IFeature)
  Dim pRowBuffer As IRowBuffer
  Dim pNewFields As IFields 'fields on target feature class
  Dim pNewField As IField
  Dim pFields As IFields 'fields on original feature class
  Dim pField As IField
  Dim FieldCount As Integer
  Dim NewFieldIndex As Long
  
  'Copy the attributes of the orig feature the new feature
  Set pRowBuffer = pFeatureBuffer
  Set pNewFields = pRowBuffer.Fields
  
  Set pFields = pFeature.Fields
  For FieldCount = 0 To pFields.FieldCount - 1
    Set pField = pFields.Field(FieldCount)
    If Not pField.Type = esriFieldTypeGeometry And Not pField.Type = esriFieldTypeOID _
      And pField.Editable Then
        NewFieldIndex = pNewFields.FindField(pField.Name)
        If Not NewFieldIndex = -1 Then
          pFeatureBuffer.Value(NewFieldIndex) = pFeature.Value(FieldCount)
        End If
    End If
  Next FieldCount
End Sub

Public Function OpenFeatureClass()Function OpenFeatureClass(strWorkspace As String, strFeatureClass As String) As IFeatureClass
  On Error GoTo ErrorHandler
  Dim pShpWorkspaceName As IWorkspaceName
  Dim pDatasetName As IDatasetName
  Dim pName As IName
  
  'Create the workspace name object
  Set pShpWorkspaceName = New WorkspaceName
  pShpWorkspaceName.PathName = strWorkspace
  pShpWorkspaceName.WorkspaceFactoryProgID = "esriCore.shapefileworkspacefactory.1"
  
  'Create the feature class name object
  Set pDatasetName = New FeatureClassName
  pDatasetName.Name = strFeatureClass
  Set pDatasetName.WorkspaceName = pShpWorkspaceName
  
  'Open the feature class
  Set pName = pDatasetName
  Set OpenFeatureClass = pName.Open
  
  Exit Function
  
ErrorHandler:
  Set OpenFeatureClass = Nothing
End Function