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()
  
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(NothingTrue)
  
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(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(strWorkspace As String, strFeatureClass As StringAs 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


你可能感兴趣的:(method)