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

'基本レイヤ(0):変数末尾にB(Base)を付与
'比較レイヤ(1):変数末尾にC(Comparison)を付与
Sub subCompleteContain()

    On Error GoTo Error
    
    'ThisDocumentの取得
    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
    Loop
    
    '検索用ジオメトリに対して空間インデックスの作成
    Dim pSpatialIndexB As ISpatialIndex
    Set pSpatialIndexB = pGeometryBagB
    pSpatialIndexB.AllowIndexing = True
    pSpatialIndexB.Invalidate
    
    '空間検索フィルタ用空間参照の取得
    Dim pGeoDatasetB As IGeoDataset
    Set pGeoDatasetB = pFeatureLayerB
    
    Dim pSpatialReferenceB As ISpatialReference
    Set pSpatialReferenceB = pGeoDatasetB.SpatialReference
    
    '空間検索フィルタの作成
    Dim pSpatialFilter As ISpatialFilter
    Set pSpatialFilter = New SpatialFilter
    
    '検索条件の変更(基本ジオメトリがPolylineの場合とそれ以外の場合)
    Dim sSpatialRelDescription As String
    If pFeatureLayerB.FeatureClass.ShapeType = esriGeometryPolyline Then
        sSpatialRelDescription = "TF**FF***"
    Else
        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
    
    pMxDocument.ActiveView.Refresh


    Exit Sub
Error:
    MsgBox Err.Description

End Sub