ArcMap 空間検索の「を完全に含む」

 2016/9/1 (木)    

Sub subCompleteContain()
    On Error GoTo Error
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    Dim pFeatureLayerB As IFeatureLayer
    Set pFeatureLayerB = pMxDocument.FocusMap.Layer(0)
    Dim pFeatureLayerC As IFeatureLayer
    Set pFeatureLayerC = pMxDocument.FocusMap.Layer(1)
    Dim pFeatureCursorB As IFeatureCursor
    Set pFeatureCursorB = pFeatureLayerB.FeatureClass.Search(Nothing, True)
    Dim pFeatureB As IFeature
    Set pFeatureB = pFeatureCursorB.NextFeature
    Dim pGeometryBagB As IGeometryCollection
    Set pGeometryBagB = New GeometryBag
    Do Until pFeatureB Is Nothing
        pGeometryBagB.AddGeometry pFeatureB.ShapeCopy
        Set pFeatureB = pFeatureCursorB.NextFeature
    Dim pSpatialIndexB As ISpatialIndex
    Set pSpatialIndexB = pGeometryBagB
    pSpatialIndexB.AllowIndexing = True
    Dim pGeoDatasetB As IGeoDataset
    Set pGeoDatasetB = pFeatureLayerB
    Dim pSpatialReferenceB As ISpatialReference
    Set pSpatialReferenceB = pGeoDatasetB.SpatialReference
    Dim pSpatialFilter As ISpatialFilter
    Set pSpatialFilter = New SpatialFilter
    Dim sSpatialRelDescription As String
    If pFeatureLayerB.FeatureClass.ShapeType = esriGeometryPolyline Then
        sSpatialRelDescription = "TF**FF***"
        sSpatialRelDescription = "T***FF***"
    End If
    With pSpatialFilter
        Set .Geometry = pGeometryBagB
        Set .Geometry.SpatialReference = pSpatialReferenceB
        .GeometryField = pFeatureLayerB.FeatureClass.ShapeFieldName
        .SearchOrder = esriSearchOrderSpatial
        .SpatialRel = esriSpatialRelRelation
        .SpatialRelDescription = sSpatialRelDescription
    End With
    Dim pFeatureSelection As IFeatureSelection
    Set pFeatureSelection = pFeatureLayerC
    pFeatureSelection.SelectFeatures pSpatialFilter, esriSelectionResultNew, False
    Exit Sub
    MsgBox Err.Description
End Sub

Copyright© WINGFIELD since1981 , 2018 All Rights Reserved.