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