Problem:  ArcMap buffer results are incorrect when buffer distance is an attribute value

Public Sub Explode()

  Dim pClone As IClone

  Dim pDataset As IDataset

  Dim pFeature As IFeature

  Dim pFeatureClass As IFeatureClass

  Dim pFeatureCursor As IFeatureCursor

  Dim pFeatureLayer As IFeatureLayer

  Dim pFeatureWorkspace As IFeatureWorkspace

  Dim pFields As IFields

  Dim pGeometryColl As IGeometryCollection

  Dim pInsertFeatureBuffer As IFeatureBuffer

  Dim pInsertFeatureCursor As IFeatureCursor

  Dim pMxDoc As IMxDocument

  Dim pNewFeatureClass As IFeatureClass

  Dim pPolygon As IPolygon2

  Dim pPolygonArray() As IPolygon



  Dim strNewFeatureClassName As String

  Dim GeometryCount As Integer

  Dim lShapeFieldIndex As Long

  

  On Error GoTo ErrorHandler

  

  Set pMxDoc = Application.Document



  'Make certain the selected item in the toc is a feature layer

  If pMxDoc.SelectedItem Is Nothing Then

    MsgBox "Select a feature layer in the table of contents as the input feature class."

    Exit Sub

  End If

  

  If Not TypeOf pMxDoc.SelectedItem Is IFeatureLayer Then

    MsgBox "No feature layer selected."

    Exit Sub

  End If

  

  Set pFeatureLayer = pMxDoc.SelectedItem

  Set pFeatureClass = pFeatureLayer.FeatureClass



  'Don't process point layers, they have no multi-part features

  If pFeatureClass.ShapeType = esriGeometryPoint Then

    MsgBox "Point layers do not have multi-parts.  Exiting."

    Exit Sub

  End If

  

  strNewFeatureClassName = InputBox("Enter New Shapefile name:", "New Shapefile")

  If strNewFeatureClassName = "" Then Exit Sub



  'Create a new feature class to store the new features

  'Create the feature class in the same dataset if one exists - shapefiles don't have one

  Set pFields = pFeatureLayer.FeatureClass.Fields

  If pFeatureClass.FeatureDataset Is Nothing Then

    Set pDataset = pFeatureClass

    Set pFeatureWorkspace = pDataset.Workspace

    Set pNewFeatureClass = pFeatureWorkspace.CreateFeatureClass(strNewFeatureClassName, pFields, Nothing, Nothing, esriFTSimple, pFeatureClass.ShapeFieldName, "")

  Else

    Set pNewFeatureClass = pFeatureClass.FeatureDataset.CreateFeatureClass(strNewFeatureClassName, pFields, Nothing, Nothing, esriFTSimple, pFeatureClass.ShapeFieldName, "")

  End If

  

  'Create an insert cursor

  Set pInsertFeatureCursor = pNewFeatureClass.Insert(True)

  Set pInsertFeatureBuffer = pNewFeatureClass.CreateFeatureBuffer

  

  'Copy each feature from the original feature class to the new feature class

  Set pFeatureCursor = pFeatureClass.Search(Nothing, True)

  Set pFeature = pFeatureCursor.NextFeature

  Do While Not pFeature Is Nothing

    Set pGeometryColl = pFeature.Shape

    If pGeometryColl.GeometryCount = 1 Then

      'Single part feature, straight copy

      InsertFeature pInsertFeatureCursor, pInsertFeatureBuffer, pFeature, pFeature.Shape

    ElseIf pFeature.Shape.GeometryType = esriGeometryPolygon Then

      Set pPolygon = pFeature.Shape

      ReDim pPolygonArray(pPolygon.ExteriorRingCount)

      pPolygon.GetConnectedComponents pPolygon.ExteriorRingCount, pPolygonArray(0)

      For GeometryCount = 0 To pPolygon.ExteriorRingCount - 1

        InsertFeature pInsertFeatureCursor, pInsertFeatureBuffer, pFeature, pPolygonArray(GeometryCount)

      Next GeometryCount

    Else

      'Multipart feature, create a new feature from each part

      For GeometryCount = 0 To pGeometryColl.GeometryCount - 1

        InsertFeature pInsertFeatureCursor, pInsertFeatureBuffer, pFeature, pGeometryColl.Geometry(GeometryCount)

      Next GeometryCount

    End If

    

    'Get the next feature

    Set pFeature = pFeatureCursor.NextFeature

  Loop

  

  Exit Sub 'Exit sub to avoid error handler

  

ErrorHandler:

  MsgBox "An error occurred. Check that the shapefile specified doesn't already exist."

  Exit Sub

End Sub



Private Sub InsertFeature(pInsertFeatureCursor As IFeatureCursor, pInsertFeatureBuffer As IFeatureBuffer, pOrigFeature As IFeature, pGeometry As IGeometry)

  Dim pGeometryColl As IGeometryCollection

  Dim pFields As IFields

  Dim pField As IField

  Dim pPoint As IPoint

  Dim pPointColl As IPointCollection

  Dim FieldCount As Integer



  'Copy the attributes of the orig feature the new feature

  Set pFields = pOrigFeature.Fields

  For FieldCount = 0 To pFields.FieldCount - 1  'skip OID and geometry

    Set pField = pFields.Field(FieldCount)

    If Not pField.Type = esriFieldTypeGeometry And Not pField.Type = esriFieldTypeOID _

      And pField.Editable Then

        pInsertFeatureBuffer.Value(FieldCount) = pOrigFeature.Value(FieldCount)

    End If

  Next FieldCount

    

  'Handle cases where parts are passed down

  If pGeometry.GeometryType = esriGeometryPath Then

    Set pGeometryColl = New Polyline

    pGeometryColl.AddGeometries 1, pGeometry

    Set pGeometry = pGeometryColl

  ElseIf pGeometry.GeometryType = esriGeometryRing Then

    Set pGeometryColl = New Polygon

    pGeometryColl.AddGeometries 1, pGeometry

    Set pGeometry = pGeometryColl

  ElseIf pOrigFeature.Shape.GeometryType = esriGeometryMultipoint Then

    If TypeOf pGeometry Is IMultipoint Then

      Set pPointColl = pGeometry

      Set pGeometry = pPointColl.Point(0)

    End If

    Set pGeometryColl = New Multipoint

    pGeometryColl.AddGeometries 1, pGeometry

    Set pGeometry = pGeometryColl

  End If

    

  Set pInsertFeatureBuffer.Shape = pGeometry

  pInsertFeatureCursor.InsertFeature pInsertFeatureBuffer

  pInsertFeatureCursor.Flush



End Sub