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