CATProduct内の非活動状態の構成要素を取得する｜CATIAマクロの作成方法

今回はVBAで「CATProduct内の非活動状態の構成要素を取得する」方法を紹介していきます。
これは以下のお問い合わせ内容が実現可能かを調べているときに見つけた方法です。

アセンブリデザインワークベンチにて、アセンブリファイルを開いている際に、
構成要素にあるアセンブリやパートファイルの一部が非活動化されている状況があります。
非活動化されてるデータを全検索→非表示→活動化→非表示データの全削除
というような実装をしたいと考えております。
　
活動化非活動化の制御方法がhelpを見てもわかりかねているのですが、
ご存じでしたらご教授頂けないでしょうか

お問い合わせ内容の通りCATIA VBAで「活動化/非活動化」を制御することはできません。
ただ、「非活動状態のProductを取得する方法」は思い付いたので一応ご紹介しておきます。
非常に無理やりな方法で取得しているので参考程度に見ていただければ幸いです。

また、お問い合わせの内容からすると最終的に非活動状態のProductを全て削除したいのですが、非活動状態のProductは削除も活動化させることもできません。つまりはマクロで非活動状態のProductを削除することはできません。

※ここでいう非活動状態とは以下のProduct2/Part2のような状態のProductを表します。
　([コンテキストメニュー]→[○○オブジェクト]→[構成要素を活動化/非活動化])

ー追記ー
無理矢理じゃなく取得する方法が見つかりました！
→CATProduct内の構成要素の活動状況を操作する方法

1. CATProduct内の非活動状態の構成要素を取得するコード
2. コード解説
3. まとめ

CATProduct内の非活動状態の構成要素を取得するコード

CATProductをアクティブドキュメントにして以下のコードを実行すると「DeActProColl」というコレクション内に非活動状態のProductが全て格納されます。

実行結果としてイミディエイトウィンドウに「非活動状態のProductのパーツ番号とインスタンス名」を表示するようにしています。(イミディエイトウィンドウがない場合はVBEメニューバーの[View]>[Immediate Window]をクリック)

※パーツ番号とインスタンス名が全く同じProductが複数あるとうまく動作しないので注意

Option Explicit

Sub CATMain()
    
    If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then
        MsgBox "CATProductのみ対応のマクロです。"
        Exit Sub
    End If
    
    Dim Doc As ProductDocument
    Set Doc = CATIA.ActiveDocument
    
    CATIA.RefreshDisplay = False
    
    Dim SEL As Selection
    Set SEL = Doc.Selection
    

    Dim ProColl As Collection
    Set ProColl = New Collection
    
    SEL.Search ("ｱｾﾝﾌﾞﾘｰ･ﾃﾞｻﾞｲﾝ.Product,all")
    
    Dim i As Integer
    For i = 1 To SEL.Count
        ProColl.Add SEL.Item(i).Value
    Next i
    SEL.Clear
    
    Dim DeActPartNumColl As Collection
    Set DeActPartNumColl = New Collection
    
    Dim DeActInstanceNameColl As Collection
    Set DeActInstanceNameColl = New Collection
    

    For i = 2 To ProColl.Count
    
        Set SEL = Doc.Selection
        With SEL
            .Add ProColl.Item(i)
            .Copy
            .Clear
        End With
        
        Dim TmpDoc As ProductDocument
        Set TmpDoc = CATIA.Documents.Add("Product")
        TmpDoc.Product.PartNumber = "Temp_Product"
        
        Set SEL = TmpDoc.Selection
        With SEL
            .Add TmpDoc.Product
            .PasteSpecial ("CATSpecBreakLink")
            .Clear
        
            .Add TmpDoc.Product.Products.Item(TmpDoc.Product.Products.Count)
            .Delete
        End With
        
        
        If TmpDoc.Product.Products.Count <> 0 Then
            
            Dim DeActPartNum As String
            Dim DeActInstanceName As String
            Dim InstrCheck As Integer
            
            DeActPartNum = TmpDoc.Product.Products.Item(1).PartNumber
            InstrCheck = InStrRev(DeActPartNum, ") of ")
            
            If InstrCheck <> 0 Then
                DeActPartNum = Right(DeActPartNum, Len(DeActPartNum) - InstrCheck - Len(") of ") + 1)
            End If
        
            DeActInstanceName = TmpDoc.Product.Products.Item(1).Name
        
            DeActPartNumColl.Add DeActPartNum
            DeActInstanceNameColl.Add DeActInstanceName
            
        End If
        
        TmpDoc.Close
        
    Next i


    Set SEL = Doc.Selection 'Selectionを元のProductで再定義
    
    Dim j As Integer
    Dim DeActProColl As Collection
    Set DeActProColl = New Collection
    
    For i = 1 To DeActInstanceNameColl.Count
    
        SEL.Search ("(名前='" & DeActInstanceNameColl.Item(i) & "' & ｱｾﾝﾌﾞﾘｰ･ﾃﾞｻﾞｲﾝ.Product),all")
        
        If SEL.Count = 1 Then
            DeActProColl.Add SEL.Item(1).Value
        Else
            For j = 1 To SEL.Count
                Dim TmpPro As Product
                Set TmpPro = SEL.Item(j).Value
                If DeActPartNumColl.Item(i) = TmpPro.PartNumber Then
                    DeActProColl.Add SEL.Item(j).Value
                End If
            Next j
        End If
        
        SEL.Clear
        
    Next i
    
    CATIA.RefreshDisplay = True

    '取得の確認
    If DeActProColl.Count > 0 Then
        For i = 1 To DeActProColl.Count
            Debug.Print DeActProColl.Item(i).PartNumber & " (" & DeActProColl.Item(i).Name & ")"
        Next i
    End If
    
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

Option Explicit

Sub CATMain()

If TypeName(CATIA.ActiveDocument) <> "ProductDocument" Then

MsgBox "CATProductのみ対応のマクロです。"

Exit Sub

End If

Dim Doc As ProductDocument

Set Doc = CATIA.ActiveDocument

CATIA.RefreshDisplay = False

Dim SEL As Selection

Set SEL = Doc.Selection

Dim ProColl As Collection

Set ProColl = New Collection

SEL.Search ("ｱｾﾝﾌﾞﾘｰ･ﾃﾞｻﾞｲﾝ.Product,all")

Dim i As Integer

For i = 1 To SEL.Count

ProColl.Add SEL.Item(i).Value

Next i

SEL.Clear

Dim DeActPartNumColl As Collection

Set DeActPartNumColl = New Collection

Dim DeActInstanceNameColl As Collection

Set DeActInstanceNameColl = New Collection

For i = 2 To ProColl.Count

Set SEL = Doc.Selection

With SEL

.Add ProColl.Item(i)

.Copy

.Clear

End With

Dim TmpDoc As ProductDocument

Set TmpDoc = CATIA.Documents.Add("Product")

TmpDoc.Product.PartNumber = "Temp_Product"

Set SEL = TmpDoc.Selection

With SEL

.Add TmpDoc.Product

.PasteSpecial ("CATSpecBreakLink")

.Clear

.Add TmpDoc.Product.Products.Item(TmpDoc.Product.Products.Count)

.Delete

End With

If TmpDoc.Product.Products.Count <> 0 Then

Dim DeActPartNum As String

Dim DeActInstanceName As String

Dim InstrCheck As Integer

DeActPartNum = TmpDoc.Product.Products.Item(1).PartNumber

InstrCheck = InStrRev(DeActPartNum, ") of ")

If InstrCheck <> 0 Then

DeActPartNum = Right(DeActPartNum, Len(DeActPartNum) - InstrCheck - Len(") of ") + 1)

End If

DeActInstanceName = TmpDoc.Product.Products.Item(1).Name

DeActPartNumColl.Add DeActPartNum

DeActInstanceNameColl.Add DeActInstanceName

End If

TmpDoc.Close

Next i

Set SEL = Doc.Selection 'Selectionを元のProductで再定義

Dim j As Integer

Dim DeActProColl As Collection

Set DeActProColl = New Collection

For i = 1 To DeActInstanceNameColl.Count

SEL.Search ("(名前='" & DeActInstanceNameColl.Item(i) & "' & ｱｾﾝﾌﾞﾘｰ･ﾃﾞｻﾞｲﾝ.Product),all")

If SEL.Count = 1 Then

DeActProColl.Add SEL.Item(1).Value

Else

For j = 1 To SEL.Count

Dim TmpPro As Product

Set TmpPro = SEL.Item(j).Value

If DeActPartNumColl.Item(i) = TmpPro.PartNumber Then

DeActProColl.Add SEL.Item(j).Value

End If

Next j

End If

SEL.Clear

Next i

CATIA.RefreshDisplay = True

'取得の確認

If DeActProColl.Count > 0 Then

For i = 1 To DeActProColl.Count

Debug.Print DeActProColl.Item(i).PartNumber & " (" & DeActProColl.Item(i).Name & ")"

Next i

End If

End Sub

コード解説

ここでは簡単にサンプルコードの処理の流れを解説していきます。

冒頭でもいっている通り、非活動状態のProductは削除することができません。
本コードではこの性質を利用して非活動状態のProductを判断しています。

① CATProduct内にある全てのProductを取得
② ループ文を使って取得したProduct全てに以下の処理を行う
　└ 1.取得したProductをコピー
　└ 2.新規Productを作成
　└ 3.新規Productにリンク分断して貼り付け(形式を選択して貼り付け)
　└ 4.貼り付けたProductを削除
　└ 5.削除できなかった場合はProductの名前を取得
　└ 6.新規Productを閉じる
③ 元のCATProduct内にある取得した名前と同名のProductを全て取得

これにより削除できなかったProduct、つまりは非活動状態のProductのみを取得することができます。

ただ、処理内容を見ると分かる通り、新規Productを作っては閉じ作っては閉じの繰り返しなので取得までに時間がかかってしまいます。また、削除できなかったProductを直接取得しているわけではなく、削除できなかったProductの名前を取得してからその名前と同じProductを再度取得しにいっているので間違いが発生する懸念もあります。

まとめ

今回はVBAで非活動状態のProductを取得する方法の紹介でした。

本来CATIA VBAでは取得することのできないProductの活動状態を、無理やり取得しにいった結果が今回のコードです。何度もいいますがゴリ押しで取得しにいくコードなので良いコードとはとても言えるものではありません。あくまでも「確かにこういったやり方もあるよね」というような参考程度に見てもらえれば幸いです。