指定した要素の周囲要素を取得する2

こちらの続きです。

"周囲要素を取得する" と書いておきながら、画面に表示されたものを
取得している為、遠くに有るのに "周囲の要素" を判断されている事は
昨日の時点で気が付いていました・・・。

これを改善しようと考えたのが、ﾘﾌﾚｰﾑｵﾝ & 検索した後、ｶﾒﾗを逆向きに
した上で再度検索します。　2回の検索両方でHitしたものが "周囲の要素"
になるのでは無いか？　と安易なｱｲﾃﾞｱで試みました。
ついでにﾘﾌﾚｰﾑｵﾝしたまま終了するのは不親切な為、画面をﾘﾌﾚｰﾑｵﾝする
前の状態にも戻しています。

'vba sample_Get_Outskirt_Items ver0.02  using-'KCL'
'指定した要素(GSD)の周囲の要素を取得
Option Explicit

Sub CATMain()
    'ｸﾘｱ
    Dim Doc As Document: Set Doc = CATIA.ActiveDocument
    Dim Sel As Selection: Set Sel = Doc.Selection
    Call Sel.Clear

    '言語別 "ﾘﾌﾚｰﾑ ｵﾝ" ｺﾏﾝﾄﾞ文字取得
    Dim ReframeOnCommand$
    ReframeOnCommand = GetReframeOnString()
    If ReframeOnCommand = vbNullString Then Exit Sub
    
    '選択
    Dim Msg$: Msg = "GSD要素を選択して下さい : ESCｷｰ 終了"
    Dim HShape As HybridShape
    Set HShape = KCL.SelectItem(Msg, Array("HybridShape"))
    If KCL.IsNothing(HShape) Then Exit Sub
    
    'ｽﾀｰﾄView
    Dim StartScene As Variant: StartScene = GetScene3D(GetViewPnt3D())
    
    'ﾘﾌﾚｰﾑ ｵﾝ の為の再選択
    Call Sel.Add(HShape)
    Call CATIA.StartCommand(ReframeOnCommand)
    
    'ﾘﾌﾚｰﾑ ｵﾝし終わるまでの時間稼ぎ
    If MsgBox("これの周辺要素を取得しますか？", vbYesNo) = vbNo Then Exit Sub
    
    'ﾘﾌﾚｰﾑ ｵﾝ 側要素取得
    Dim FrontItems As Variant: FrontItems = GetSearchItems()
    Debug.Print "1回目ﾋｯﾄ数:" + CStr(Sel.Count2)
    
    '逆向き
    Dim RevScene As Variant: RevScene = GetReverseScene3D(GetScene3D(GetViewPnt3D()))
    'Dim RevScene As Variant: RevScene = GetReverseScene3D(GetViewPnt3D())
    Call UpdateScene(RevScene)
    
    Call Sel.Clear
    Call Sel.Add(HShape)
    Call CATIA.StartCommand(ReframeOnCommand)
    
    '逆ﾘﾌﾚｰﾑ ｵﾝ 側要素取得
    Dim BackItems As Variant: BackItems = GetSearchItems()
    Debug.Print "2回目ﾋｯﾄ数:" + CStr(Sel.Count2)
    
    '両側で取得している要素のみを選択状態にする
    Call RemoveSelItem(Sel, GetSelRemoveList(FrontItems, BackItems))
    
    '表示を戻す
    Call UpdateScene(StartScene)
    
    MsgBox CStr(Sel.Count2) + "個選択しました"
    
End Sub

'ﾘｽﾄのｲﾝﾃﾞｯｸｽをを元に選択解除する
Private Sub RemoveSelItem(ByRef Sel As Selection, ByVal List As Collection)
    Dim Idx
    Debug.Print "選択除外数:" + CStr(List.Count)
    CATIA.HSOSynchronized = False
    For Each Idx In List
        Sel.Remove2 Idx
    Next
    CATIA.HSOSynchronized = True
End Sub

'BackAryからFrontAryの減算処理
'後の検索後の選択状態から、Selection.Remove2する為のﾘｽﾄのｲﾝﾃﾞｯｸｽを逆順で取得
Private Function GetSelRemoveList(ByVal FrontAry As Variant, ByVal BackAry As Variant) As Collection
    Dim FrontDic As Object: Set FrontDic = KCL.InitDic()
    Dim i&
    For i = 1 To UBound(FrontAry)
        Call FrontDic.Add(FrontAry(i), 0)
    Next
    
    Dim RemoveList As Collection: Set RemoveList = New Collection
    For i = UBound(BackAry) To 1 Step -1
        If Not FrontDic.Exists(BackAry(i)) Then
            RemoveList.Add i
        End If
    Next
    Set GetSelRemoveList = RemoveList
End Function

'検索の "画面上の表示" で取得(InternalName)
Private Function GetSearchItems() As Variant
    Dim Sel As Selection: Set Sel = CATIA.ActiveDocument.Selection
    CATIA.HSOSynchronized = False
    Sel.Clear
    Sel.Search "Type=*,scr"
    
    Dim Items() As Variant: ReDim Items(Sel.Count2)
    Dim i&
    For i = 1 To Sel.Count2
        Items(i) = GetInternalName(Sel.Item2(i).Value)
    Next
    CATIA.HSOSynchronized = True
    GetSearchItems = Items
End Function

'言語別ﾘﾌﾚｰﾑ ｵﾝｺﾏﾝﾄﾞ文字取得
Private Function GetReframeOnString() As String
    Select Case KCL.GetLanguage()
        Case "ja"
            GetReframeOnString = "ﾘﾌﾚｰﾑ ｵﾝ"
        Case "en"
            GetReframeOnString = "Reframe On"
        Case Else
            '日本語でﾒｯｾｰｼﾞ出して意味が有るのか?
            MsgBox "言語設定が、日本語か英語のみしか対応していません"
    End Select
End Function

'表示のUpdate
Private Sub UpdateScene(ByVal Scene As Variant)
    Dim Viewer As Viewer3D: Set Viewer = CATIA.ActiveWindow.ActiveViewer
    Dim VPnt3D As Variant 'Viewpoint3D
    Set VPnt3D = Viewer.Viewpoint3D
    
    Dim Ary As Variant
    Ary = GetRangeAry(Scene, 0, 2)
    Call VPnt3D.PutOrigin(Ary)
    
    Ary = GetRangeAry(Scene, 3, 5)
    Call VPnt3D.PutSightDirection(Ary)
    
    Ary = GetRangeAry(Scene, 6, 8)
    Call VPnt3D.PutUpDirection(Ary)
    
    VPnt3D.FieldOfView = Scene(9)
    VPnt3D.FocusDistance = Scene(10)
    
    Call Viewer.Update
End Sub

'Viewpoint3Dからｼｰﾝ取得
Private Function GetScene3D(ByVal ViewPnt3D As Viewpoint3D) As Variant
    Dim vp As Variant: Set vp = ViewPnt3D
    Dim SceneAry As Variant
    
    Dim origin(2) As Variant: Call vp.GetOrigin(origin)
    
    Dim sight(2) As Variant: Call vp.GetSightDirection(sight)
    SceneAry = JoinAry(origin, sight)
    
    Dim up(2) As Variant: Call vp.GetUpDirection(up)
    SceneAry = JoinAry(SceneAry, up)
    
    Dim FieldOfView(0) As Variant: FieldOfView(0) = vp.FieldOfView
    SceneAry = JoinAry(SceneAry, FieldOfView)
    
    Dim FocusDist(0) As Variant: FocusDist(0) = vp.FocusDistance
    GetScene3D = JoinAry(SceneAry, FocusDist)
End Function

'現状の視点取得
Private Function GetViewPnt3D() As Viewpoint3D
    Set GetViewPnt3D = CATIA.ActiveWindow.ActiveViewer.Viewpoint3D
End Function

'逆Vec
Private Function RevVec(ByVal vec As Variant) As Variant
    RevVec = Array(vec(0) * -1, vec(1) * -1, vec(2) * -1)
End Function

'逆ｼｰﾝ取得
Private Function GetReverseScene3D(ByVal Scene As Variant) As Variant
    Dim Ary1 As Variant: Ary1 = GetRangeAry(Scene, 0, 2)
    
    Dim sight As Variant: sight = RevVec(GetRangeAry(Scene, 3, 5))
    Ary1 = JoinAry(Ary1, sight)
    
    Dim Ary2 As Variant: Ary2 = GetRangeAry(Scene, 6, 10)
    GetReverseScene3D = JoinAry(Ary1, Ary2)
End Function

これは、ﾚﾀﾘﾝｸﾞｽﾀｲﾙを "透視投影" にしていると、1個もHitしない可能性が
あるため注意してください。

結果を先に書くと、処理時間がかなり増える(ちょっと待たされる)のに、
前回と変わらなかったです・・・。ｱｲﾃﾞｱが安易過ぎました。　ので失敗です。

実はCATIAﾕｰｻﾞｰではない方でも "VBAわかるよ" と言う方に
"もうちょっと効率の良い処理方法ないですか？"
と言う部分があるのでご相談したいです。

こちらの部分が結構悩みました。

'BackAryからFrontAryの減算処理
'後の検索後の選択状態から、Selection.Remove2する為のﾘｽﾄのｲﾝﾃﾞｯｸｽを逆順で取得
Private Function GetSelRemoveList(ByVal FrontAry As Variant, ByVal BackAry As Variant) As Collection
    Dim FrontDic As Object: Set FrontDic = KCL.InitDic()
    Dim i&
    For i = 1 To UBound(FrontAry)
        Call FrontDic.Add(FrontAry(i), 0)
    Next
    
    Dim RemoveList As Collection: Set RemoveList = New Collection
    For i = UBound(BackAry) To 1 Step -1
        If Not FrontDic.Exists(BackAry(i)) Then
            RemoveList.Add i
        End If
    Next
    Set GetSelRemoveList = RemoveList
End Function

何を行いたいのかと言うと(厳密には、このｺｰﾄﾞはそのようには書いていませんが)
"二つの文字列配列が有り、重複する要素だけを取得したい"
と言う処理方法です。
"二つの配列を重複しないように連結する" と言う処理は、比較的需要も有り
手法も何となくわかるのですが、"重複するもののみ" と言うのが非常に悩ましかったです。

こちらのｺｰﾄﾞでは、片方の配列をﾊｯｼｭﾃｰﾌﾞﾙ(Scripting.Dictionary)に一度全て
入れ、Exists関数を利用して重複を判断しました。　2重ﾙｰﾌﾟよりは良いかな？と
判断した上でですが。
一応調べたところ "Filter関数" の存在を知りましたが、1つの文字型配列の中に
指定した条件（文字が含まれている）ものだけ（又は逆）を配列として返す関数
のようで、今回思っていたものとはちょっと異なりました。
（2重ﾙｰﾌﾟとFilter関数の組み合わせだと、大量に配列を作りそうな気がしたので･･･）

C#ATIA

↑ﾀｲﾄﾙ詐欺　主にFusion360API　偶にCATIA V5 VBA(絶賛ネタ切れ中)

指定した要素の周囲要素を取得する2