C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

青い問題2

時間が経過していますが、こちらの続きです。
青い問題 - C#ATIA

青色部分を動かす方法がやっと分かりました。
こちらがかなりヒントになりました。(答え?)
COE : Forums : Some stuff about the BLUE PROBLEM!

まず、この様なサンプルを用意しました。

アクティブな状態は一番上の"Product1"の位置(ここが青色)で、
"Part2"の"形状セット.2"を"作業オブジェクトとして設定"とする事を
ゴールとします。
念の為、"Part2"の作業オブジェクトは"形状セット.1"の状態です。

この様なマクロを作成しました。

'vba
Option Explicit

'目的のPartNumber
Private Const TARGET_PART_NUMBER = "Part2"

'目的の形状セット名
Private Const TARGET_GEOSET_NAME = "形状セット.2"

Sub CATMain()

    'トップのドキュメント取得
    'Product内のPartがアクティブであってもProductDocumentになります
    Dim prodDoc As ProductDocument
    Set prodDoc = CATIA.ActiveDocument

    'Selection取得
    Dim sel As Selection
    Set sel = prodDoc.Selection
    sel.Clear

    '目的の形状セットを探す
    '検索でも良いのかも・・・
    Dim prods As Products
    Set prods = prodDoc.product.Products

    Dim prod As product
    Dim hBody As HybridBody
    Dim pt As Part
    
    For Each prod In prods
        If prod.PartNumber = TARGET_PART_NUMBER Then
            '該当するPartNumber発見
            
            'Part取得
            Set pt = prod.ReferenceProduct.Parent.Part
            
            '形状セットを探す
            For Each hBody In pt.HybridBodies
                If hBody.name = TARGET_GEOSET_NAME Then
                    '形状セットを発見
                    
                    '該当する形状セットを選択
                    sel.Add hBody
                    
                    '"パートデザイン"のワークベンチスタート
                    CATIA.Application.StartWorkbench "PrtCfg"
                    
                    '"作業オブジェクトとして設定"を実行
                    pt.InWorkObject = hBody

                End If
            Next
        End If
    Next
End Sub

実行後はこの様な状態になります。

ゴールにはたどり着けました。が、続けてマクロを実行すると
新たなCATPartが起動します・・・。
その辺がリンク先のCOEに記載されています。


コメントに記載しましたが、Productのウィンドウがアクティブな状態の場合、
Partに入った状態であっても"CATIA.ActiveDocument"はProductDocumentを
返してきます。
その為、現在のワークベンチをチェックする必要があると思われます。
こんな感じですね。

    CATIA.Application.GetWorkbenchId

"PrtCfg"の場合はPartに入った状態で、"Assembly"の場合はPartに入っていない
状態です。
念の為、こちらの状態も"Assembly"になります。

"PrtCfg"を返してくる場合、一度こちらを実行すれば良さそうです。

CATIA.Application.StartWorkbench "Assembly"

ここまでやるつもりは無かったのですが、先程の物を修正すると、
サンプルデータのどの位置がアクティブでも、ゴールに辿り着けるように
なりました。

'vba
Option Explicit

'目的のPartNumber
Private Const TARGET_PART_NUMBER = "Part2"

'目的の形状セット名
Private Const TARGET_GEOSET_NAME = "形状セット.2"

Sub CATMain()

    'トップのドキュメント取得
    'Product内のPartがアクティブであってもProductDocumentになります
    Dim prodDoc As ProductDocument
    Set prodDoc = CATIA.ActiveDocument
    
    'Partに入っている場合は一度抜ける
    If CATIA.Application.GetWorkbenchId = "PrtCfg" Then
        CATIA.Application.StartWorkbench "Assembly"
    End If

    'Selection取得
    Dim sel As Selection
    Set sel = prodDoc.Selection
    sel.Clear

    '目的の形状セットを探す
    '検索でも良いのかも・・・
    Dim prods As Products
    Set prods = prodDoc.product.Products

    Dim prod As product
    Dim hBody As HybridBody
    Dim pt As Part
    
    For Each prod In prods
        If prod.PartNumber = TARGET_PART_NUMBER Then
            '該当するPartNumber発見
            
            'Part取得
            Set pt = prod.ReferenceProduct.Parent.Part
            
            '形状セットを探す
            For Each hBody In pt.HybridBodies
                If hBody.name = TARGET_GEOSET_NAME Then
                    '形状セットを発見
                    
                    '該当する形状セットを選択
                    sel.Add hBody
                    
                    '"パートデザイン"のワークベンチスタート
                    CATIA.Application.StartWorkbench "PrtCfg"
                    
                    '"作業オブジェクトとして設定"を実行
                    pt.InWorkObject = hBody

                End If
            Next
        End If
    Next
End Sub

ちょっとしか試していないので、問題が出るかもしれません。
(深いAssyデータやCGRが含まれるデータ等)

4年越しの問題解決。