Convert Mulipoint to Points

Created:10/23/2002
Description:

The convertMultipointToPoints sub below shows how you can convert Multipoint to Point



How to use:
  1. Open ArcMap, open the VBA editor and paste the code below into the code window.
  2. Add a point layer (Output) in position 0 in ArcMap and add a multipoint feature class containing the same fields as the point feature class in position 1 (In the table of contents).
  3. Run the convertMultipointToPoints sub.
Option Explicit

Sub convertMultipointToPoints()
Dim pm As IMxDocument
Dim pflmp As IFeatureLayer
Dim pflp As IFeatureLayer
Dim pfclsmp As IFeatureClass
Dim pfclsp As IFeatureClass
Dim pfcmp As IFeatureCursor
Dim puid As New UID
Dim papp As IApplication
Dim ped As IEditor
Dim pdset As IDataset
Dim pfmp As IFeature
Dim pfp As IFeature
Dim ptcoll As IPointCollection
Dim i As Long
Dim j As Long
Set pm = ThisDocument
Set pflp = pm.FocusMap.Layer(0) 'Point
Set pflmp = pm.FocusMap.Layer(1) 'Multipoint
Set pfclsmp = pflmp.FeatureClass 'Multipoint feature class
If Not pfclsmp.ShapeType = esriGeometryMultipoint Then
MsgBox "Must have multipoint in position 1 in TOC"
Exit Sub
End If
Set pfclsp = pflp.FeatureClass 'Point feature class
If Not pfclsp.ShapeType = esriGeometryPoint Then
MsgBox "Must have point in position 0 in TOC"
Exit Sub
End If
Set pfcmp = pfclsmp.Search(Nothing, True) 'Get a cursor on the multipoint feature class
'Cursor not recycling because editing
'Get the editor
Set papp = Application
puid = "esriCore.Editor"
Set ped = papp.FindExtensionByCLSID(puid)
Set pdset = pfclsp
ped.StartEditing pdset.Workspace
Set pfmp = pfcmp.NextFeature
While Not pfmp Is Nothing
Set ptcoll = pfmp.ShapeCopy
For i = 0 To ptcoll.PointCount - 1
   Set pfp = pfclsp.CreateFeature 'Create a point feature
   Set pfp.Shape = ptcoll.Point(i) 'Set the feature equal to each point in the multipoint
   If pfp.Fields.FieldCount = pfmp.Fields.FieldCount Then 'Try to copy the field value
   For j = 0 To pfp.Fields.FieldCount - 1
      If Not pfp.Fields.Field(j).Type = esriFieldTypeGeometry And Not pfp.Fields.Field(j).Type = esriFieldTypeOID Then
      pfp.Value(j) = pfmp.Value(j)
      End If
   Next
   End If
   pfp.Store 'Store the point feature
Next
Set pfmp = pfcmp.NextFeature 'Get the next multipoint
Wend
ped.StopEditing True
pm.ActiveView.Refresh
End Sub