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
- Paste the code into VBA.
- 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.
- Execute the JoinByLocation_Nearest routine.
- 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")
Else
Exit Sub
End If
Loop
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
pDoc.UpdateContents
End If
Exit Sub
EH:
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
Loop
End Function