コピペ "結果として" のボディを作る

タイトルが言葉足らず過ぎますが、久々にCATIAです。

マクロ実行後、ESCキーが押されるまで、クリックしたボディを
”結果として” でコピペし、そのボディが子になるようにアセンブルします。

言葉じゃ分かりにくいです。

左の状態でボディ2をクリックしたら、右の状態のボディを作ります。

何がしたいのかと言うと、客先からの支給データが差し替えになった際、
古いデータと新しいデータを視覚的に比較したいので、古いデータを
一時的に残しておきたいんです！！

連日この作業を何度も行っていたのですが、さすがに嫌になりました。

'vba Part_AddBody_ver0.0.2  using-'KCL0.0.12'  by Kantoku

Private Const HEADER = ""
Private Const FOOTER = "_OLD"

Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not KCL.CanExecute("PartDocument") Then Exit Sub
    
    Dim msg$: msg = "ｸﾛｰﾝﾎﾞﾃﾞｨのﾍｯﾀﾞ,ﾌｯﾀﾞを入力して下さい"
    Dim NewName$: NewName = vbNullString
    NewName = InputBox(msg, , HEADER & "," & FOOTER)
    If NewName = vbNullString Then Exit Sub
    
    Dim NameAry As Variant: NameAry = Split(NewName, ",")
    If UBound(NameAry) < 1 Then Exit Sub
    
    msg = "ｸﾛｰﾝするBodyを選択して下さい : ESCｷｰ 終了"
    Dim SelElem As SelectedElement
    Dim InBool As Boolean
    Dim clone As Body
    
    Do
        Set SelElem = KCL.SelectElement(msg, Array("Body"))
        If SelElem Is Nothing Then Exit Do
        Dim BodyOj As Body: Set BodyOj = SelElem.Value
        Dim pt As Part: Set pt = KCL.GetParent_Of_T(BodyOj, "Part")
        
        ' 結果として
        Set clone = cloneBody(BodyOj, pt)

        Call InitNewBody(clone, pt, NameAry(0), NameAry(1))
        pt.Update
continue:
    Loop
End Sub

Private Function cloneBody( _
    ByVal bdy As Body, _
    ByVal pt As Part)
    
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    Dim clone As Body

    With sel
        .Clear
        .Add bdy
        .Copy
        .Add pt
        .PasteSpecial "CATPrtResultWithOutLink"
        Set clone = .Item2(1).Value
        
        'Call resetProp
        
        .Clear
    End With
    
    clone.name = bdy.name
    
    Set cloneBody = clone
    
End Function

Private Sub resetProp()
    
'    Dim shell As Object
'    Set shell = CreateObject("WScript.Shell")
'
'    Call CATIA.StartCommand("ﾌﾟﾛﾊﾟﾃｨをﾘｾｯﾄ")
'
'    shell.SendKeys "{ENTER}"

    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    Dim vis As VisPropertySet
    Set vis = sel.VisProperties
    
    vis.SetRealColor 210, 210, 255, 1
    vis.SetRealOpacity 255, 1

End Sub

Private Sub InitNewBody( _
    ByVal bdy As Body, _
    ByVal pt As Part, _
    ByVal Head As String, _
    ByVal Foot As String)

    Dim BdyName$: BdyName = bdy.name
    Dim fact As ShapeFactory: Set fact = pt.ShapeFactory
    
    Dim NewBdy As Body: Set NewBdy = pt.Bodies.Add()
    NewBdy.name = Head + BdyName + Foot
    
    Dim Assem As Assemble: Set Assem = fact.AddNewAssemble(bdy)
    Call pt.UpdateObject(Assem)
End Sub

本当は色をリセットしたいので、”プロパティをリセット”を
”子に適応” まで入れて行いたいのですが、上手く行きません。

海外のサイトを調べても
・StartCommandで行う
・デフォルトの色を割り当てる
が見つかりましたが、望んだ結果とはならず、、、
諦めて手動で行う事にします。不便だな。