PROBLEM
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.
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.
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.
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
Get help from ArcGIS experts
Download the Esri Support App