タイトルが異なりますが、こちらの続きです。
画面キャプチャをクリップボードに保存する - 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操作できるのかな?)