Join by location - nearest


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 point shapefile layer and the second a polygon shapefile layer. Optionally, you can modify the 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 later modify 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 = "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 = name Then
      Check_for_shapefile = True
      Exit Do
    End If
    Set pDS = pED.Next
End Function