How to perform a spatial join

This sample performs a join by location (spatial join) between a point layer and a polygon layer in the table of contents. The join appends the attributes of the 1st point in the point layer that falls inside each polygon in the polygon layer. An example of this would be associating the analytical results of an ore sample with the polygon that outlines the outcropping it was taken from.
The point attributes are appended to an output join by location layer. You will be prompted for the name of the output layer which is created as a shapefile in the polygon layer's directory.
In order for the script to work properly, the first layer in the table of contents must be a point layer and the second must by the polygon layer on which to base the join. The input layers must also be shapefiles.

How to use

  1. Paste the code into VBA.
  2. Make sure that the first layer in the table of contents is a pointshapefile layer and the second a polygon shapefile layer. Optionally, you can modifythe code to specify the proper layer and table and proper output type.
  3. Execute the JoinByLocation_Nearest routine.
  4. When prompted, provide the name of the output shapefile. You can latermodify the code to provide a name automatically.
Public Sub JoinByLocation_Nearest()
    On Error GoTo EH
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    ' The 1st layer in the table of contents must
    ' be a point layer and the second must be an
    ' area layer. Joining point attributes to polygon
    Dim pPntLayer As IFeatureLayer
    Dim pAreaLayer As IFeatureLayer
    Set pPntLayer = pMap.Layer(0)
    Set pAreaLayer = pMap.Layer(1)
    ' Get the output workspace name - make it
    ' the same as the input polygon layer in the join
    Dim pDataset As IDataset
    Dim pWkSpDataset As IDataset
    Dim pWkSpName As IWorkspaceName
    Set pDataset = pAreaLayer.FeatureClass
    Set pWkSpDataset = pDataset.Workspace
    Set pWkSpName = pWkSpDataset.FullName
    ' create the name object for the output join by location shapefile
    Dim strOutName As String
    Dim pFCName As IFeatureClassName
    Dim pOutDSName As IDatasetName
    Dim pName As IName
    strOutName = InputBox("Enter the output shapefile name:", "Join by Location sample", "JnByLocSample")
    Do While Check_for_shapefile(pDataset.Workspace, strOutName)
        If (MsgBox("The shapefile already exists, try another name?", vbOKCancel) = vbOK) Then
            strOutName = InputBox("Enter the output shapefile name:", "Join by Location sample", "JnByLocSample")
            Exit Sub
        End If
    Set pFCName = New FeatureClassName
    With pFCName
        .FeatureType = esriFTSimple
        .ShapeFieldName = "Shape"
        .ShapeType = esriGeometryPolygon
    End With
    Set pOutDSName = pFCName
    With pOutDSName
        .Name = strOutName
        Set .WorkspaceName = pWkSpName
    End With
    Set pName = pOutDSName
    ' Do a join by location that joins the attributes of the
    ' first point cantained within each polygon.
    Dim pSpJoin As ISpatialJoin
    Dim pFCNew As IFeatureClass
    Set pSpJoin = New SpatialJoin
    With pSpJoin
        Set .JoinTable = pPntLayer.FeatureClass
        Set .SourceTable = pAreaLayer.FeatureClass
        .LeftOuterJoin = True
    End With
    ' setting maxMapDist to 0 means that only points within
    ' each each polygon will be considered
    Set pFCNew = pSpJoin.JoinNearest(pName, 0)
    ' Create a new layer and add it to the Map
    If Not pFCNew Is Nothing Then
        Dim pNewFLayer As IFeatureLayer
        Set pNewFLayer = New FeatureLayer
        Set pNewFLayer.FeatureClass = pFCNew
        pNewFLayer.Name = "Sample Join by Location"
        pMap.AddLayer pNewFLayer
    End If
    Exit Sub
    MsgBox "JoinByLocation_Nearest: " & Err.Number & " " & Err.Description
End Sub

Private Function Check_for_shapefile(pWkspace As IWorkspace, Name As String) As Boolean
    '++ Check to see if shapefile already exists
    Dim nm2 As String
    Dim pED As IEnumDataset
    Dim pDS As IDataset
    Set pED = pWkspace.Datasets(esriDTAny)
    Set pDS = pED.Next
    'Get the first dataset for the wkspace
    Check_for_shapefile = False
    Do Until pDS Is Nothing
        If pDS.Name = Name Then
            Check_for_shapefile = True
            Exit Do
        End If
        Set pDS = pED.Next
End Function