C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

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

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

"パラメータを作成するのに処理時間がかかる" との事でしたので、
代案として、XY平面に元の背景色をバックアップする事にしました。

又、Formのボタンで操作可能なもののサンプルにして見ました。

まず、新作したFormにコマンドボタンを2つ配置します。
それぞれの名前はそのままなのですが、念の為記載しておきます。
・UserForm1
・CommandButton1
・CommandButton2
f:id:kandennti:20171120162151p:plain

このフォームのコード部分に以下のコードを貼り付けます。

'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度続けて、"背景色-白" ボタンを押すと、復元不可能になります。