ディテールシートの未使用のビューを削除

図面を作成する際、面倒なので新規のDrawファイルからでは無くて
他のファイルを流用して作りますよね？（・・・違うかな）
最大の理由はカタログから呼び出した際、分離してディテールシートに
残しているのですが、再度同じものをカタログから呼び出すのが面倒だからです。

差し替えが上手くいけば問題無いですし、UUID違いもこちらのマクロで
それなりの事が出来るようになりました。
異なるUUIDのDraw参照元ファイルを差し替える3 - C#ATIA
（知り合いの方から、新規に作成した方が早いんじゃない？　と
アドバイスを頂きました。　・・・確かにそうです。）

ビューの原点も（ｲﾛｲﾛ問題は有りますが）こちらで変更できるようになりました。
Drawﾋﾞｭｰの原点を変更する1 - C#ATIA

こんな感じで流用していると、つまらない意地と言いますか、見栄と言いますか
ディテールシートに未使用のビューが幾つか残ったりするのですが、嫌なんです。
使用している物を削除しようとすると警告してくれるので、手動でも出来ない
ことは無いのですが、、、面倒なんです。

そこでDrawファイル内で、2Dコンポーネントとして使用されていない
ディテールシートのビューを削除するマクロを作成しました。

'vba DetailSheetCleaner_ver0.0.1  using-'KCL0.0.13'  by Kantoku
Option Explicit

Sub CATMain()
    
    Dim msg As String
    
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute(Array("DrawingDocument")) Then Exit Sub
    
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    'ﾃﾞｨﾃｰﾙｼｰﾄ
    Dim dets As Collection
    Set dets = GetDetailSheet(doc)
    If dets.Count < 1 Then
        MsgBox "ﾃﾞｨﾃｰﾙｼｰﾄが有りません!"
        Exit Sub
    End If
    
    '全ｺﾝﾎﾟｰﾈﾝﾄ 空の可能性も有り
    Dim cmps As Collection
    Set cmps = GetComps(doc.Sheets)
    
    'ﾃﾞｨﾃｰﾙｼｰﾄﾋﾞｭｰ辞書
    Dim compDic As Object
    Set compDic = InitDetailDic(dets)
    
    '未使用ﾃﾞｨﾃｰﾙｼｰﾄﾋﾞｭｰ
    Dim UnuseComps As Collection
    Set UnuseComps = GetUnuseCompsList(compDic, cmps)
    If UnuseComps.Count < 1 Then
        MsgBox "削除対象のﾋﾞｭｰが有りません!"
        Exit Sub
    End If
    
    '確認
    msg = UnuseComps.Count & _
        "個の未使用ﾃﾞｨﾃｰﾙｼｰﾄのﾋﾞｭｰが有ります。" & vbCrLf & _
        "全て削除しますか?"

    If MsgBox(msg, vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If
    
    '削除
    Call RemoveComps(UnuseComps)
    
    MsgBox "Done"
End Sub

Private Sub RemoveComps( _
    ByVal lst As Collection)
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
    
    CATIA.HSOSynchronized = False
    
    Dim vi As DrawingView
    
    With sel
        .Clear
        For Each vi In lst
            .Add vi
        Next
        .Delete
    End With
    
    CATIA.HSOSynchronized = True
    
End Sub

Private Function GetComps( _
    ByVal shts As DrawingSheets) As Collection
    
    Dim cmps As Collection
    Set cmps = New Collection
    
    Dim st As DrawingSheet
    Dim vi As DrawingView
    Dim i As Long
    For Each st In shts
        For Each vi In st.views
            For i = 1 To vi.Components.Count
                cmps.Add vi.Components.Item(i)
            Next
        Next
    Next
    
    Set GetComps = cmps
    
End Function

Private Function GetUnuseCompsList( _
    ByVal compDic As Object, ByVal cmps As Collection) _
    As Collection
        
    Dim cmp As DrawingComponent
    Dim key As String
    For Each cmp In cmps
        key = GetKeyString(cmp.CompRef)
        If compDic.Exists(key) Then
            compDic(key) = Array(True, compDic(key)(1))
        End If
    Next
    
    Dim lst As Collection
    Set lst = New Collection
    
    Dim ary As Variant
    For Each ary In compDic.Items
        If ary(0) = False Then
            lst.Add ary(1)
        End If
    Next
    
    Set GetUnuseCompsList = lst
    
End Function

Private Function GetKeyString( _
    ByVal vi As DrawingView) As String
    
    GetKeyString = vi.Parent.Parent.Name & "@" & _
        KCL.GetInternalName(vi)
End Function

Private Function InitDetailDic( _
    ByVal dets As Collection) As Object
    
    Dim dic As Object
    Set dic = KCL.InitDic()
    
    Dim st As DrawingSheet
    Dim i As Long
    Dim vi As DrawingView
    For Each st In dets
        For i = 3 To st.views.Count
            Set vi = st.views.Item(i)
            dic.Add GetKeyString(vi), Array(False, vi)
        Next
    Next
    
    Set InitDetailDic = dic
    
End Function

Private Function GetDetailSheet( _
    ByVal doc As DrawingDocument) As Collection
    
    Dim dets As Collection
    Set dets = New Collection
    
    Dim st As DrawingSheet
    For Each st In doc.Sheets
        If st.IsDetail Then
            dets.Add st
        End If
    Next
    
    Set GetDetailSheet = dets
    
End Function