コマンドID

あけましておめでとうございます。
今年もコンセプトがブレたまま、マイペースでやってまいります。

CATIAのｲﾝｽﾄｰﾙﾌｫﾙﾀﾞ内に [.CATNls] の拡張子のﾌｧｲﾙがあるのをご存知でしょうか？
恐らくですが、これらのファイルは画面上に表示されている文字類を
設定するファイルなのだろうと思います。
(言語別にﾌｫﾙﾀﾞで分類されており、言語を切り替え再起動した際
　これらのﾌｧｲﾙが読み込まれ表示される文字が切り替わるのだろうと思います）

海外のサイトで、このファイルについて書かれている記事を何度か見ては
いたのですが、コマンド名に関するものであまり深く受け止めていませんでした。
（今更コマンド名を知った所で、何かﾒﾘｯﾄがあるとは思えなかったので）

年末頃、こちらの記載を見て、何故CATNlsﾌｧｲﾙについて知りたがるのか
やっと理解できました。
CATIA.StartCommand CommandID finden (Dassault Systemes - PLM Solutions/CATIA V5 Programmierung) - Foren auf CAD.de

CATNlsﾌｧｲﾙ内の記載されている右辺のコマンド名が重要なのではなく
左辺に記載されているﾌﾟﾛﾊﾟﾃｨ名が、コマンドIDなのだろう　と言うことのようです。
このコマンドIDは、言語設定に関わらずコマンド呼び出し出来るもののようです。

実際に行った動画です。
最初はコマンドIDとなる [c:CATHpwAxisLineHdr] で実行し
2度目は日本語設定依存となる [c:軸] で実行しています。

確かに、実行できます。

ﾏｸﾛで提供されていないｵﾌﾞｼﾞｪｸﾄを生成する際、最終手段として
[CATIA.StartCommand] を利用せざるを得ない場面があるかも知れませんが
その際、どうしても言語設定を判断し利用する事になります。
（その為にこの辺を作りました
お手軽に言語判定を行いたい - C#ATIA
C#でお手軽に言語判定を行いたい2 - C#ATIA
）
ですが、言語設定に依存しないコマンドIDがわかっていれば、言語判定
すら不要になります。

しかしこのコマンドIDのﾘｽﾄが見つからないんです。
仕方ないので、英語と日本語のﾘｽﾄを作成し、こちらにUpしました。
GrabCAD - CAD library

兎に角、ﾌｧｲﾙ数が多い為ﾌﾘｰｿﾌﾄと簡単なｽﾌﾟﾘｸﾄを作成し、
"Hdr.Title" の記載された行を抜き出し、Excelで整えつつ
軽くﾁｪｯｸしてみただけなので、中身については保証できません。

背景色を変更・復元する3

こちらの続きで、保留していた宿題です。
背景色を変更・復元する2 - C#ATIA

ご要望としては、PartでもProductでも同様の処理を行いたい
と言うことなので、修正してみました。

PartDocumentの取得方法を変更する必要があるため、
こちらの部分を修正します。

Private Sub UserForm_Initialize()
    'Form設定
    Me.CommandButton1.Caption = "背景色-白"
    Me.CommandButton2.Caption = "背景色-復元"
    
    '一時的な背景色
    mBackColor = Array(255, 255, 255)
    
    'CATIA情報
    Set mDoc = Get_PartDoc(CATIA.ActiveDocument)
    If mDoc Is Nothing Then
        MsgBox "Partﾌｧｲﾙが見つかりません"
        Me.CommandButton1.Enabled = False
        Me.CommandButton2.Enabled = False
        Exit Sub
    End If
    Set mPt = mDoc.Part
    Set mSel = mDoc.Selection
    Set mVis = mSel.VisProperties
    Set mVisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
End Sub

そして実際にPartDocumentを取得する為の関数を
追加します。(再帰で一番上部にあるPartDocumentを探しています)

Private Function Get_PartDoc(Doc As Document) As PartDocument
    If Not Get_PartDoc Is Nothing Then Exit Function
    
    Dim Pros As Products
    Dim i As Long
    
    Select Case TypeName(Doc)
        Case "PartDocument"
            Set Get_PartDoc = Doc
            Exit Function
    
        Case "ProductDocument"
            Set Pros = Doc.Product.Products
            If Pros.Count < 1 Then Exit Function
            
            For i = 1 To Pros.Count
                Set Get_PartDoc = _
                    Get_PartDoc(Pros.Item(i).ReferenceProduct.Parent)
                If Not Get_PartDoc Is Nothing Then Exit Function
            Next
        
        Case Else
            Exit Function
    End Select
End Function

Part・Product両方で動くﾏｸﾛを作成する際、結論としては
どうやってPartDocumentを取得するか？　だけの違いで他の部分は
共通です行えます。

Productの場合、例えﾃﾞｻﾞｲﾝﾓｰﾄﾞでPartﾌｧｲﾙを操作している状態で
あっても

   set Doc = CATIA.ActiveDocument

を実行した場合、一番上のProductのDocumentが取得されます。
(子ｳｨﾝﾄﾞｳの一番上と言うイメージです)

ｺｯﾎ曲線を描く

こちらの12年も前の記事なのですが、楽しそうなので
CATIAで行ってみました。
再帰プログラムによるフラクタル図形の描画：CodeZine（コードジン）

'vba sample_Koch_Curve_ver0.0.1  using-'KCL0.0.12'  by Kantoku
'xy平面上にｺｯﾎ曲線を作成します
'https://codezine.jp/article/detail/73

Option Explicit

Private Const LEVEL = 3         '再帰ﾚﾍﾞﾙ

Dim mPnts As Object             'Get_KochCurvePos用座標郡
Dim mDoc As PartDocument
Dim mPt As Part
Dim mFact As HybridShapeFactory

'定数代わり
Dim m1_3 As Double              '1/3
Dim m1_Sq3 As Double            '1/sqr(3)
Dim mPI_6 As Double             'PAI/6 = 30deg

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("PartDocument") Then Exit Sub
    
    '初期設定
    m1_3 = 1 / 3
    m1_Sq3 = 1 / Sqr(3)
    mPI_6 = Atn(1) * 4 / 6
    
    Set mDoc = CATIA.ActiveDocument
    Set mPt = mDoc.Part
    Set mFact = mPt.HybridShapeFactory
    
    '頂点座標
    Dim p1, p2, p3
    p1 = Array(100#, 160#)
    p2 = Array(400#, 160#)
    p3 = Array(250#, 420#)
    
    '座標値取得
    Set mPnts = KCL.InitLst()
    mPnts.Add p1
    
    Call Get_KochCurvePos(p1, p2, LEVEL)
    Call Get_KochCurvePos(p2, p3, LEVEL)
    Call Get_KochCurvePos(p3, p1, LEVEL)
    
    '座標値→点ﾘﾌｧﾚﾝｽ
    Dim Refs As Object
    Set Refs = Get_PointRefs(mPnts)
    
    '折れ線化
    Dim Poly  As HybridShapePolyline
    Set Poly = Init_Poly(Refs)
    
    '形状ｾｯﾄへ挿入
    Dim Hbdy As HybridBody
    Set Hbdy = mPt.hybridBodies.Add()
    Hbdy.Name = "Koch_Curve"
    
    Hbdy.AppendHybridShape Poly
    
    'Refsの最後の点のみ不要
    mFact.DeleteObjectForDatum Refs(Refs.Count - 1)
    
    '終わり
    MsgBox "Done"
End Sub

'ﾘﾌｧﾚﾝｽﾘｽﾄから折れ線生成
Private Function Init_Poly(ByVal Refs As Object) As HybridShapePolyline
    Dim Poly As HybridShapePolyline
    Set Poly = mFact.AddNewPolyline()
    
    Dim i As Long
    For i = 0 To Refs.Count - 2
        Poly.InsertElement Refs(i), i
    Next
    Poly.Closure = True
    mPt.UpdateObject Poly
    
    Set Init_Poly = Poly
End Function

'xy座標値郡から点のﾘﾌｧﾚﾝｽﾘｽﾄ生成
Private Function Get_PointRefs(ByVal Lst As Object) As Object
    Dim Refs As Object
    Set Refs = KCL.InitLst
    
    Dim p As Variant
    For Each p In mPnts
        Refs.Add Init_PointRef(p)
    Next
    
    Set Get_PointRefs = Refs
End Function

'xy座標値から点のﾘﾌｧﾚﾝｽ生成
Private Function Init_PointRef(ByVal Ary As Variant) As Reference
    Dim p As HybridShapePointCoord
    Set p = mFact.AddNewPointCoord(Ary(0), Ary(1), 0#)
    mPt.UpdateObject p
    
    Set Init_PointRef = mPt.CreateReferenceFromObject(p)
End Function

'ｺｯﾎ曲線座標
Private Sub Get_KochCurvePos(ByVal p1 As Variant, ByVal p2 As Variant, lv As Long)
    Dim p3 As Variant, p4 As Variant, p5 As Variant
    p3 = Array((2 * p1(0) + p2(0)) * m1_3, (2 * p1(1) + p2(1)) * m1_3)
    p4 = Array((p1(0) + 2 * p2(0)) * m1_3, (p1(1) + 2 * p2(1)) * m1_3)
    
    Dim xx As Double, yy As Double
    xx = p2(0) - p1(0)
    yy = -(p2(1) - p1(1))
    
    Dim dist As Double
    dist = Sqr(xx * xx + yy * yy) * m1_Sq3
    
    Dim ang As Double
    If xx >= 0 Then
        ang = Atn(yy / xx) + mPI_6
        p5 = Array(p1(0) + (dist * Cos(ang)), p1(1) - (dist * Sin(ang)))
    Else
        ang = Atn(yy / xx) - mPI_6
        p5 = Array(p2(0) + (dist * Cos(ang)), p2(1) - (dist * Sin(ang)))
    End If
    
    If lv < 1 Then
        mPnts.Add p3
        mPnts.Add p5
        mPnts.Add p4
        mPnts.Add p2
    Else
        Call Get_KochCurvePos(p1, p3, lv - 1)
        Call Get_KochCurvePos(p3, p5, lv - 1)
        Call Get_KochCurvePos(p5, p4, lv - 1)
        Call Get_KochCurvePos(p4, p2, lv - 1)
    End If
End Sub

再帰でやるのもどうかな？　とも思ったのですが、再帰の為の記事だったので
再帰のままです。

元の記事では、座標値を計算しながら線を描いてますが、
まとめて座標値を取得し、一本一本描かずに折れ線化しています。
(他にも計算ｺｽﾄの高そうな部分は、予めﾒﾝﾊﾞ変数化し計算量を減らしてます)

円を指定して内接するようにしようかとも思いましたが、
利用価値が低そうなので、単にXY平面に描くだけにしました。

見ていたら雪の結晶を思い出し、よけいに寒くなりました･･･。

背景色を変更・復元する2

こちらの続きです。
背景色を変更・復元する - C#ATIA

"ﾊﾟﾗﾒｰﾀを作成するのに処理時間がかかる" との事でしたので、
代案として、XY平面に元の背景色をﾊﾞｯｸｱｯﾌﾟする事にしました。

又、Formのﾎﾞﾀﾝで操作可能なもののｻﾝﾌﾟﾙにして見ました。

まず、新作したFormにｺﾏﾝﾄﾞﾎﾞﾀﾝを2つ配置します。
それぞれの名前はそのままなのですが、念の為記載しておきます。
・UserForm1
・CommandButton1
・CommandButton2

このﾌｫｰﾑのｺｰﾄﾞ部分に以下のｺｰﾄﾞを貼り付けます。

'vba sample_ChangeBackColor ver0.0.2 by Kantoku
'CATIAの背景色を変更・復元
Option Explicit

'ﾒﾝﾊﾞ変数
Dim mDoc As PartDocument
Dim mPt As Part
Dim mSel As Selection
Dim mVis As VisPropertySet
Dim mVisSetAtt As VisualizationSettingAtt
Dim mBackColor As Variant

Private Sub UserForm_Initialize()
    'Form設定
    Me.CommandButton1.Caption = "背景色-白"
    Me.CommandButton2.Caption = "背景色-復元"
    
    '一時的な背景色
    mBackColor = Array(255, 255, 255)
    
    'CATIA情報
    Set mDoc = CATIA.ActiveDocument
    Set mPt = mDoc.Part
    Set mSel = mDoc.Selection
    Set mVis = mSel.VisProperties
    Set mVisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
End Sub

'ｺﾏﾝﾄﾞﾎﾞﾀﾝ1
Private Sub CommandButton1_Click()
    Call ChangeBackColor
End Sub

'ｺﾏﾝﾄﾞﾎﾞﾀﾝ2
Private Sub CommandButton2_Click()
    Call RestorationBackColor
End Sub

' --- ｻﾎﾟｰﾄ関数 ---

'BACKCOLORに変更
Private Sub ChangeBackColor()
    Dim Color As Variant
    
    '背景色取得
    Color = Get_BackRGB()
    
    'XY平面に割り当て
    Call Set_PlaneRGB(mPt.OriginElements.PlaneXY, Color)
    
    '背景色変更
    Call Set_BackRGB(mBackColor)
End Sub

'復元
Sub RestorationBackColor()
    Dim Color As Variant
    
    'XY平面色取得
    Color = Get_PlaneRGB(mPt.OriginElements.PlaneXY)
    
    '背景色復元
    Call Set_BackRGB(Color)
    
    'YZ平面色取得
    Color = Get_PlaneRGB(mPt.OriginElements.PlaneYZ)
    
    'XY平面色復元
    Call Set_PlaneRGB(mPt.OriginElements.PlaneXY, Color)
End Sub

Private Function Set_PlaneRGB(ByVal Plane As Plane, _
                              ByVal Color As Variant)
    mSel.Clear
    mSel.Add Plane
    
    mVis.SetRealColor Color(0), Color(1), Color(2), 1
    mSel.Clear
End Function

Private Function Get_PlaneRGB(ByVal Plane As Plane)
    mSel.Clear
    mSel.Add Plane
    
    Dim Color(2) As Long
    mVis.GetRealColor Color(0), Color(1), Color(2)
    mSel.Clear
    Get_PlaneRGB = Color
End Function

Private Sub Set_BackRGB(ByVal Color As Variant)
    Call mVisSetAtt.SetBackgroundRGB( _
        Color(0), Color(1), Color(2))
    mVisSetAtt.SaveRepository
End Sub

Private Function Get_BackRGB() As Variant
    Dim Color(2) As Long
    Call mVisSetAtt.GetBackgroundRGB( _
        Color(0), Color(1), Color(2))
    Get_BackRGB = Color
End Function

"例外処理は要らない" との事なので、ほぼしておりません。
念の為、
・PartDocument以外はｴﾗｰになります。
・背景色復元後、XY平面色も復元させていますが、
　その際YZ平面色をXY平面に反映させています。(通常同じだろうと･･･)
・2度続けて、"背景色-白" ﾎﾞﾀﾝを押すと、復元不可能になります。

StartCommandとRefreshDisplay

別のものを作成しているうちに気が付いたので覚書なのですが、
ひょっとしたら既出なのかも知れません。

CATIAのﾏｸﾛでは、全てのｺﾏﾝﾄﾞ類を実行する為の関数類が提供されて
いるわけではないのですが、

CATIA.StartCommand xxxx(ｺﾏﾝﾄﾞ文字列)

を利用すると、手動での実行時のﾀﾞｲｱﾛｸﾞが出現する為、不可能と
思われたことが可能になる場合が有ります。
こちらで作成したｼﾙｴｯﾄｺﾏﾝﾄﾞの無意味なｻﾝﾌﾟﾙも、そんな方法です。
ｼﾙｴｯﾄ(事前選択+CATIA.StartCommand) - C#ATIA

但し、困るのは "StartCommand" は、ﾀﾞｲｱﾛｸﾞを呼び出してくれる
だけなので、"事前選択" と "SendKeys" を利用する事になります。
･･･が、"SendKeys"　がﾅｶﾅｶの曲者で、思ったようなﾀｲﾐﾝｸﾞでは
文字を送ってくれないです。

そんな例として、一つ。
手動の場合は事前に面を選択し形状ｾｯﾄを作ると、子の要素として
取り入れた状態で、形状ｾｯﾄが新たに作成されます。
言葉では伝わりにくいので、こんな感じの操作です。

　
形状ｾｯﾄを作る為の関数は用意されているのですが、子の要素を
取り入れながら形状ｾｯﾄ新たに作成する関数は存在していないです。
恐らく。
こう言った場合、"StartCommand" を利用する以外には方法が無さ
そうなので、こんな感じのｺｰﾄﾞを作成しました。

'vba これNGです using-'KCL0.0.12'
'選択した要素を子とする形状ｾｯﾄを作成

'ｺﾏﾝﾄﾞ文字列
Private Const CMD = "形状ｾｯﾄ..."

Sub CATMain()
    Dim Shp As HybridShape
    Set Shp = KCL.SelectItem("GSD要素を選択", "HybridShape")
    If Shp Is Nothing Then Exit Sub
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    
    Sel.Clear
    Sel.Add Shp
    
    CATIA.StartCommand CMD
    SendKeys "{Enter}", True
End Sub

子の要素を選択状態のまま、形状ｾｯﾄを作成するｺﾏﾝﾄﾞを呼び出し、
最後にEnterｷｰを投げています。
悪くもない感じがするのですが、実際に実行してみるとこのような
ﾀﾞｲｱﾛｸﾞが表示された状態で終わってしまします。

    SendKeys "{Enter}", True

の部分が上手く行ってないです。
こんな感じのものや
http://www.geocities.co.jp/SiliconValley-PaloAlto/9180/exsendkeys.html
ｳｪｲﾄさせたりしても変化無しでした。

試していて感じたのは、ﾀﾞｲｱﾛｸﾞが表示されるのが遅いのではなく、
ﾏｸﾛの処理を待った上で、ﾀﾞｲｱﾛｸﾞが表示されるような気さえします。

そこでこんな感じ1行追加しただけで、上手く行くようになりました。

'vba sample_Init_HybridBody_InsItem_ver0.0.1  using-'KCL0.0.12'  by Kantoku
'選択した要素を子とする形状ｾｯﾄを作成

'ｺﾏﾝﾄﾞ文字列
Private Const CMD = "形状ｾｯﾄ..."

Sub CATMain()
    Dim Shp As HybridShape
    Set Shp = KCL.SelectItem("GSD要素を選択", "HybridShape")
    If Shp Is Nothing Then Exit Sub
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    
    Sel.Clear
    Sel.Add Shp
    
    CATIA.StartCommand CMD
    CATIA.RefreshDisplay = True '追加
    SendKeys "{Enter}", True
End Sub

RefreshDisplayを間に挟んだところ、Enterｷｰを認識してくれました。

単に画面の更新を入れるだけで、良かったみたいです。
少しだけ "StartCommand" の利用する場面が増えそうな気がします。
本当は、 "形状ｾｯﾄの変更" をやりたいんですけどね。

背景色を変更・復元する

ﾀｲﾄﾙが異なりますが、こちらの続きです。
画面ｷｬﾌﾟﾁｬをｸﾘｯﾌﾟﾎﾞｰﾄﾞに保存する - C#ATIA

単に背景色を切り替えるﾏｸﾛです。
但し元の背景色に復元出来る様に、変更前の背景色RGBをﾊﾟﾗﾒｰﾀに
保存しています。
(外部ﾌｧｲﾙや何処かのﾌﾟﾛﾊﾟﾃｨに書き出すより、自然かと思います)

'vba sample_ChangeBackColor ver0.0.1 by Kantoku
'CATIAの背景色を変更・復元

Option Explicit

'背景色をﾊﾞｯｸｱｯﾌﾟするﾊﾟﾗﾒｰﾀ名
Private Const BACKCOLOR_PRAM_NAME = "BackColorRGB"

'変更後背景色
Private Const BACKCOLOR = "255,255,255"

Sub CATMain()
    Dim Doc As Document
    Set Doc = CATIA.ActiveDocument
    
    Dim Msg As String
    
    Dim Prms As Parameters
    Set Prms = Get_Prms(Doc)
    If Prms Is Nothing Then
        Msg = "ProductかPartで使用してください"
        MsgBox Msg
        Exit Sub
    End If
    
    Msg = "背景色を変更しますか?" & vbNewLine & _
        "はい : 背景色を変更(RGB:" & BACKCOLOR & ")" & vbNewLine & _
        "いいえ : ﾊﾞｯｸｱｯﾌﾟしている背景色に復元" & vbNewLine & _
        "ｷｬﾝｾﾙ : 中止"
            
    Select Case MsgBox(Msg, vbYesNoCancel + vbQuestion)
        Case vbYes
            Call ChangeBackColor(Prms) '白に変更
        Case vbNo
            Call RestorationBackColor(Prms) '復元
        Case Else
            Exit Sub
    End Select
    
End Sub

'復元
Sub RestorationBackColor(ByVal Prms As Parameters)
    Dim Msg As String
    
    If Not Is_ExistsPrm(Prms, BACKCOLOR_PRAM_NAME) Then
        Msg = "ﾊﾞｯｸｱｯﾌﾟしている背景色が有りませんでした"
        MsgBox Msg, vbOKOnly + vbExclamation
        Exit Sub
    End If
    
    Dim Prm As StrParam
    Set Prm = Prms.Item(BACKCOLOR_PRAM_NAME)
    
    If Not Is_RGB_Str(Prm.Value) Then
        Msg = "ﾊﾞｯｸｱｯﾌﾟしている背景色ﾊﾟﾗﾒｰﾀが不正です"
        MsgBox Msg, vbOKOnly + vbExclamation
        Exit Sub
    End If
    
    Call Update_BackRGB(Prm.Value)
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    With Sel
        .Clear
        .Add Prm
        .Delete
    End With
End Sub

'BACKCOLORに変更
Private Sub ChangeBackColor(ByVal Prms As Parameters)
    Dim Msg As String
    
    Dim Prm As StrParam
    If Is_ExistsPrm(Prms, BACKCOLOR_PRAM_NAME) Then
        Set Prm = Prms.Item(BACKCOLOR_PRAM_NAME)
        
        Msg = "既に背景色のﾊﾞｯｸｱｯﾌﾟがありますが、" & _
            "作業を続けますか?" & vbNewLine & _
            "はい : 新たにﾊﾞｯｸｱｯﾌﾟし、作業を進める" & vbNewLine & _
            "いいえ : ﾊﾞｯｸｱｯﾌﾟは変更せず、作業を進める" & vbNewLine & _
            "ｷｬﾝｾﾙ : 中止"
            
        Select Case MsgBox(Msg, vbYesNoCancel + vbQuestion)
            Case vbYes
                Prm.Value = Get_BackRGB_ToStr()
            Case vbNo
                '何もしない
            Case Else
                Exit Sub
        End Select
    Else
        Set Prm = Prms.CreateString(BACKCOLOR_PRAM_NAME, "")
        Prm.Value = Get_BackRGB_ToStr()
    End If
    
    Call Update_BackRGB(BACKCOLOR)
    'Prm.Hidden = True '非表示
End Sub


' --- ｻﾎﾟｰﾄ関数 ---
Private Function Is_RGB_Str(ByVal Str As String) As Boolean
    Is_RGB_Str = False
    
    Dim Ary As Variant
    Ary = Split(Str, ",")
    If Not UBound(Ary) = 2 Then Exit Function
    
    Dim i As Long
    For i = 0 To 2
        If Not IsNumeric(Ary(i)) Then Exit Function
        If Not Ary(i) = CLng(Ary(i)) Then Exit Function
    Next
    
    Is_RGB_Str = True
End Function

Private Sub Update_BackRGB(ByVal RGB_Str As String)
    Dim VisSetAtt As VisualizationSettingAtt
    Set VisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
        
    Dim Rgb As Variant
    Rgb = Split(RGB_Str, ",")

    Call VisSetAtt.SetBackgroundRGB(Rgb(0), Rgb(1), Rgb(2))
    VisSetAtt.SaveRepository
End Sub

Private Function Get_BackRGB_ToStr() As String
    Dim VisSetAtt As VisualizationSettingAtt
    Set VisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
    
    Dim ActColor(2) As Long
    Call VisSetAtt.GetBackgroundRGB( _
        ActColor(0), ActColor(1), ActColor(2))
    
    Get_BackRGB_ToStr = Join( _
        Array(ActColor(0), ActColor(1), ActColor(2)), ",")
End Function

Private Function Init_Prm(ByVal Prms As Parameters, _
                          ByVal Name As String) As Parameter
    Set Init_Prm = Prms.CreateString(BACKCOLOR_PRAM_NAME, "")
End Function

Private Function Is_ExistsPrm(ByVal Prms As Parameters, _
                              ByVal Name As String) As Boolean
    Dim Prm As Parameter
    
    On Error Resume Next
        Set Prm = Prms.Item(Name)
    On Error GoTo 0
    
    Is_ExistsPrm = Not (Prm Is Nothing)
    
    If Not TypeName(Prm) = "StrParam" Then
        Is_ExistsPrm = False
        '文字型ﾀｲﾌﾟじゃない同一名のﾊﾟﾗﾒｰﾀがある- 未対応
    End If
End Function

Private Function Get_Prms(ByVal Doc As Document) As Parameters
    Set Get_Prms = Nothing
    Select Case TypeName(Doc)
        Case "ProductDocument"
            Set Get_Prms = Doc.Product.Parameters
        Case "PartDocument"
            Set Get_Prms = Doc.Part.Parameters
    End Select
End Function

定数 "BACKCOLOR_PRAM_NAME" と同一名の文字型以外のﾊﾟﾗﾒｰﾀが存在していると
上手く行かないです･･･。(対応策を深く考えませんでした)

又、KCLを利用しなかったのでDocumentのﾁｪｯｸがやや甘めです。

変更・復元を一つのﾏｸﾛ(最初のMsgboxで切り替え)で行っている為、
使い勝手がｲﾏｲﾁなのですが、ﾌﾞﾛｸﾞでFormのｺｰﾄﾞをUp出来ないので
ご勘弁を。

正直な所、このようなﾏｸﾛよりｷｬﾌﾟﾁｬをｼﾞｬﾝｼﾞｬﾝ作るﾏｸﾛの方が、
効率が良い気がするのですが･･･。

例えば、ﾃﾞｰﾀをｽﾞｰﾑ・ｽﾋﾟﾝさせながら、ｽﾍﾟｰｽｷｰを押すたびに
ｷｬﾌﾟﾁｬﾌｧｲﾙを作る　とか、
ｽﾍﾟｰｽｷｰを押すたびにExcelにｷｬﾌﾟﾁｬを貼り付けるとか･･･。
(当方Excelが古いため試せませんが、ひょっとしたらCATIAから
Excel操作できるのかな?)

画面ｷｬﾌﾟﾁｬをｸﾘｯﾌﾟﾎﾞｰﾄﾞに保存する

「CATIAで背景色を白にした状態で、画面のｷｬﾌﾟﾁｬをｸﾘｯﾌﾟﾎﾞｰﾄﾞに取得したい」
と相談を頂きました。

ｸﾘｯﾌﾟﾎﾞｰﾄﾞではなく、ﾌｧｲﾙとしてであればこちらの方法がお手軽かと
思います。
背景の設定を維持しつつ背景を白でキャプチャを行う | PLM Tips Magazine

'vba sample_Capture2Clipboard ver0.0.1 by Kantoku
'CATIAのｷｬﾌﾟﾁｬをｸﾘｯﾌﾟﾎﾞｰﾄﾞに保存

'--- WinAPI ---
'capture - https://qiita.com/nezuq/items/95cad79d9a9dd920d30e
#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
#Else
    Private Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
#End If

Const VK_SNAPSHOT = &H2C             '[PrintScrn]キー

Const KEYEVENTF_EXTENDEDKEY = &H1    'キーを押す
Const KEYEVENTF_KEYUP = &H2          'キーを放す

'wait
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'--- 設定 ---
'ｷｬﾌﾟﾁｬ時の背景色 RGB
Private Const BACKCOLOR = "255,255,255"

'ｷｬﾌﾟﾁｬ取得待ち時間 ここの時間は調整してください
Private Const WAITTIME = 200

Option Explicit

Sub CATMain()
    '現在の背景色
    Dim VisSetAtt As VisualizationSettingAtt
    Set VisSetAtt = CATIA.SettingControllers.Item("CATVizVisualizationSettingCtrl")

    Dim ActColor(2) As Long
    Call VisSetAtt.GetBackgroundRGB(ActColor(0), ActColor(1), ActColor(2))
    
    '背景色変更
    Dim rgb As Variant
    rgb = Split(BACKCOLOR, ",")

    Call VisSetAtt.SetBackgroundRGB(rgb(0), rgb(1), rgb(2))
    VisSetAtt.SaveRepository
    
    If MsgBox("ｷｬﾌﾟﾁｬしますか?", vbYesNo + vbInformation) = vbYes Then
        Call Sleep(WAITTIME)
        Call Exec_Capture 'ｷｬﾌﾟﾁｬ
    End If
    
    '背景色を戻す
    Call VisSetAtt.SetBackgroundRGB(ActColor(0), ActColor(1), ActColor(2))
    VisSetAtt.SaveRepository
End Sub

'ｷｬﾌﾟﾁｬ
Private Sub Exec_Capture()
    AppActivate CATIA.Caption, True
    
    keybd_event &HA4, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1, 0&
    keybd_event vbKeySnapshot, 0&, &H1 Or &H2, 0&
    keybd_event &HA4, 0&, &H1 Or &H2, 0&
End Sub

32bitでも対応できるようにしたつもりですが、試す環境が無い為
未ﾃｽﾄです。

WinAPIでPrintScrnｷｰを押しているのですが、ﾀｲﾐﾝｸﾞが難しく
確認用のﾀﾞｲｱﾛｸﾞを出したり、ｳｪｲﾄしたりしてます。
環境によってはﾀﾞｲｱﾛｸﾞの残像が残ってしまう可能性があるため、

Private Const WAITTIME = 200

の数値を修正して頂く必要があるかもしれません。

又、最初に紹介した方法では、ｱｸﾃｨﾌﾞなｳｨﾝﾄﾞｳをｷｬﾌﾟﾁｬしたﾌｧｲﾙが出来上がるのに
対して、このﾏｸﾛではCATIA全体のｷｬﾌﾟﾁｬになってしまう為、ｲﾏｲﾁです。
(ｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙとか取得すれば何とかなるのかな?)