選択面の抽出

「抽出を行いたいが、選択面のみにならずに全体の面になってしまう」
と、ご相談を頂きました。

面の選択の際のﾌｨﾙﾀｰの問題かと思ったのですが、どうやら違うようです。
こちらで確認した所、これであれば選択面のみの抽出が出来ています。

'vba
Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄ等
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As part
    Set pt = doc.part
    
    '選択
    Dim msg As String
    msg = "面選択"
    
    Dim filter As Variant
    filter = Array("Face")
    
    Dim sel As Variant ' Selection
    Set sel = doc.Selection
    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Sub
    End Select
    
    'ﾘﾌｧﾚﾝｽ取得
    Dim selectFace As AnyObject
    Set selectFace = sel.Item(1).Reference
    
    '抽出
    Dim face As AnyObject
    Set face = InitExtract(pt, selectFace)
    
    '形状ｾｯﾄ作成・挿入
    Dim hb As HybridBody
    Set hb = pt.hybridBodies.Add()
    
    hb.AppendHybridShape face
    
    MsgBox "Done"
End Sub

'抽出
Private Function InitExtract(ByVal pt As part, ByVal ref As Reference) _
                    As HybridShapeExtract
    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory
    
    Dim hybridShapeExtract1 As HybridShapeExtract
    Set hybridShapeExtract1 = fact.AddNewExtract(ref)
    
    hybridShapeExtract1.PropagationType = 3
    hybridShapeExtract1.ComplementaryExtract = False
    hybridShapeExtract1.IsFederated = False
    
    pt.UpdateObject hybridShapeExtract1
    Set InitExtract = hybridShapeExtract1
End Function

今回はSelectionからReferenceを取得してそのまま抽出する際の
Referenceとして使えましたが、場合によってはBrapﾈｰﾑから
Referenceを取得しなければならない場合もあるかも知れません。