English

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

Description

Attribute values can be used as buffer distances in the ArcMap Buffer Wizard. When using the "Based on a distance from an attribute" option the results are sometimes incorrect.

Cause

The is a known issue when buffering multipoint using attribute values as the buffer distance. Only one of the points in the multipoint group will be buffered.

Solution or Workaround

To buffer multipoints using attribute values you will first need to create a temporary layer comprised of single points instead of multipoints. You can use a VBA macro to explode the multipoint features of the layer you wish to buffer into its individual point features. The macro create a new layer - the original multipoint layer is untouched. You can then buffer the new point layer.

  1. Paste the following VBA code in ArcMap.
    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



    Note:
    See the ArcMap On-line help topic "Creating, editing, and running macros" for more information

  2. Select the layer you want to buffer in the Table of Contents
  3. Run the Explode macro
  4. The result will be saved in the same dataset as the selected features, or it the selected layer is a shapefile, then the result will be stored under the same directory as the shapefile.
  5. Buffer the result of the explode using the an attribute as the buffer distance.
  6. Delete the explode result layer.