CATPart内ｴﾗｰ時のUpdateObject

こちらでコメント頂いた
「GetMeasurableはUpdate出来ないと長さも取得できそうにありません」
について、解決されたようですが、試しているうちに知らなかった事に
出くわした為、記載しておきます。
選択した円弧の長さを表示1 - C#ATIA

ﾃｽﾄしたﾃﾞｰﾀはこんな感じです。

ﾃﾞｰﾀをUp出来れば良いのですが･･･
全てXY平面上にあり、線は各点を端点としています。
この状態から、点P4の座標値を(5,20,0)→(5,5,0)にﾏｸﾛで変更させ
L3（P4-P5）の長さを取得します。
途中で交差（ITS)が履歴内に入っていますが、L3とは無関係です。
但し、P4の座標値を変更する事で交差がｴﾗｰとなってしまう状態です。
（要は、取得したい線とは無関係な部分でｴﾗｰが起きている状態にします）

Sub CATMain()
    '準備
    Dim Doc As PartDocument: Set Doc = CATIA.ActiveDocument
    Dim Pt As Part: Set Pt = Doc.Part
    Dim Hss As HybridShapes: Set Hss = Pt.HybridBodies.Item(1).HybridShapes
    Call Pt.Update
    
    Debug.Print "*** ｴﾗｰ時の線の長さ取得ﾃｽﾄ ｽﾀｰﾄ ***"
    
    '長さを取得したい線
    Dim L3 As HybridShape: Set L3 = Hss.Item("L3")
    Dim L3Ref As Reference: Set L3Ref = Pt.CreateReferenceFromGeometry(L3)
    
    '変更する点-本当はHybridShapePointCoord
    Dim P4Vri As Variant: Set P4Vri = Hss.Item("P4")
    
    '長さ測定
    Dim L3Lng As Double
    L3Lng = Doc.GetWorkbench("SPAWorkbench").GetMeasurable(L3Ref).length
    Debug.Print "変更前(ｴﾗｰ無し) : " & CStr(L3Lng) & "mm"
    
    '端点位置変更 - 未更新
    Call P4Vri.SetCoordinates(Array(5, 5, 0))
    
    '更新-ｴﾗｰ発生
    On Error Resume Next
        '本当はｴﾗｰで止まる
        Call Pt.Update
    On Error GoTo 0
    L3Lng = Doc.GetWorkbench("SPAWorkbench").GetMeasurable(L3Ref).length
    Debug.Print "変更後(ｴﾗｰ)-Update : " & CStr(L3Lng) & "mm"
    
    '目的の要素のみﾛｰｶﾙ更新
    Call Pt.UpdateObject(L3)
    L3Lng = Doc.GetWorkbench("SPAWorkbench").GetMeasurable(L3Ref).length
    Debug.Print "変更後-UpdateObject_線のみ : " & CStr(L3Lng) & "mm"
    
    '目的の要素の履歴分ﾛｰｶﾙ更新
    Call Pt.UpdateObject(P4Vri)
    Call Pt.UpdateObject(L3)
    L3Lng = Doc.GetWorkbench("SPAWorkbench").GetMeasurable(L3Ref).length
    Debug.Print "変更後-UpdateObject_点・線 : " & CStr(L3Lng) & "mm"
End Sub

PartのUpdateでは、ｴﾗｰが出る為 "On Error Resume Next" を利用してます。

実際に試した結果はこちら

*** ｴﾗｰ時の線の長さ取得ﾃｽﾄ ｽﾀｰﾄ ***
変更前(ｴﾗｰ無し) : 10mm
変更後(ｴﾗｰ)-Update : 10mm
変更後-UpdateObject_線のみ : 25mm
変更後-UpdateObject_点・線 : 25mm

Update（ｴﾗｰが発生した状態）では、未更新な状態な為変更される前の
長さを取得してしまいます。
[目的の要素のみﾛｰｶﾙ更新] と [目的の要素の履歴分ﾛｰｶﾙ更新](こっちは無意味)
では、単にL3のみの更新とP4・L3の更新の違いです。
実は、 [目的の要素のみﾛｰｶﾙ更新] では "上手く行かないかも" と思っていたの
ですが、依存する要素(今回はP4）も更新されました。
過去に履歴を時系列順に更新してやらないと上手く出来なかった事が
あったので、僕の場合はこのように更新するように心掛けています。

ここからが試すまで知らなかった事です。
上記のｺｰﾄﾞを最初このようにしていました。

	・・・
    '目的の要素のみﾛｰｶﾙ更新
    Call Pt.UpdateObject(L3Ref) 'ｵﾌﾞｼﾞｪｸﾄではなくﾘﾌｧﾚﾝｽを更新
    L3Lng = Doc.GetWorkbench("SPAWorkbench").GetMeasurable(L3Ref).length
    Debug.Print "変更後-UpdateObject_線のみ : " & CStr(L3Lng) & "mm"

実はこれで問題無いと思っていたからです。
実際に実行してみると、UpdateObject時にｴﾗｰとなってしまいました。

AutomationManualを見るとUpdateObjectﾒｿｯﾄﾞの引数は
"AnyObject" で Referenceｵﾌﾞｼﾞｪｸﾄ は "AnyObject" を継承しており
実際によく利用しています。

上記の事を考えると、CATPart内でｴﾗｰが発生している場合は、ﾘﾌｧﾚﾝｽでの
UpdateObjectでは、正しく処理されないようです。
各要素のｵﾌﾞｼﾞｪｸﾄとﾘﾌｧﾚﾝｽは、ほぼ同等のものと思っていたのですが･･･。

こちらも非常に勉強になりました。

ｱｸﾃｨﾌﾞCATPartを、Igesﾌｧｲﾙにﾊﾞｯﾁ変換

ちょっと業務上欲しくなったので、CATPartﾌｧｲﾙをIgesに変換する為の
ﾏｸﾛを作成しました。" ﾏｸﾛにする必要ある? " と思った方、正解です。

単に変換するだけであれば、必要性を感じないのですが、ｵﾌﾟｼｮﾝの
こちらの部分を変更しｿﾘｯﾄﾞとｻｰﾌｪｽで二回変換してます。

ｵﾌﾟｼｮﾝを表示させる際、CATIA起動後の一回目は少し間が空くんですよね。
二回目以降はｽﾄﾚｽ無く表示されるのですが。

又、変換処理時間が結構かかる場合もあるので、ﾊﾞｯﾁﾓｰﾄﾞを利用し
ｵﾍﾟﾚｰｼｮﾝを奪われないようにしました。

'vba sample_ExpIges_Surf_Solid_ver0.0.1  using-'ver0.0.10'
'ｱｸﾃｨﾌﾞなPartﾌｧｲﾙをIges(Surface/Solid)でｴｸｽﾎﾟｰﾄ

Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not KCL.CanExecute("PartDocument") Then Exit Sub
    
    'ﾄﾞｷｭﾒﾝﾄ取得/ﾁｪｯｸ
    Dim PDoc As PartDocument: Set PDoc = CATIA.ActiveDocument
    If PDoc.Saved = False Then
        If MsgBox("変更されています。上書き保存し作業を続けますか?", vbYesNo) = vbNo Then Exit Sub
        PDoc.Save
    End If
    
    'ｱｸﾃｨﾌﾞﾊﾟｽ
    Dim FullPath As String: FullPath = PDoc.FullName
    If FullPath = vbNullString Then
        MsgBox "新規ﾌｧｲﾙです。一度保存を行ってから再実行してください!"
        Exit Sub
    End If
    Dim Path As Variant: Path = KCL.SplitPathName(FullPath)
    
    'ｴｸｽﾎﾟｰﾄ用ﾊﾟｽ
    Dim SurfPath As String
    SurfPath = KCL.GetNewName(Path(0) & "\" & Path(1) & "_Surface.igs")
    
    Dim SolidPath As String
    SolidPath = KCL.GetNewName(Path(0) & "\" & Path(1) & "_Solid.igs")
    
    'Iges設定取得 0-Surface 1-Solid
    Dim IgsMSBO As Long
    IgsMSBO = CATIA.SettingControllers.Item("CATIdeIgesSettingCtrl").ExportMSBO
    
    'catiaの実行ﾌｧｲﾙﾊﾟｽ取得
    Dim CatPath  As String
    CatPath = CATIA.SystemService.Environ("CATDLLPath")
    
    '環境ﾌｧｲﾙﾊﾟｽ取得
    Dim EnvironmentPath  As Variant
    EnvironmentPath = KCL.SplitPathName(CATIA.SystemService.Environ("CATEnvName"))
    
    '確認
    Dim Msg As String
    Msg = "[ " & Path(1) & " ]をIges(ｻｰﾌｪｽ/ｿﾘｯﾄﾞ)に変換します。" & vbNewLine & _
            "宜しいですか?"
    If MsgBox(Msg, vbYesNo) = vbNo Then Exit Sub
    
    'ﾊﾞｯﾁ用ﾏｸﾛﾌｧｲﾙ作成
    Dim MacroPath  As String
    MacroPath = KCL.GetNewName(Path(0) & "\" & Path(1) & ".catvbs")
    Call KCL.WriteFile(MacroPath, CreateCatvbsSource(FullPath, SurfPath, SolidPath, MacroPath, IgsMSBO))
    
    'ﾊﾞｯﾁﾓｰﾄﾞ起動
    Call ExecuteButchMode(CatPath & "\CNEXT.exe", EnvironmentPath(0), EnvironmentPath(1), MacroPath)
    
    MsgBox "変換処理を始めました!"
End Sub

'ﾊﾞｯﾁﾓｰﾄﾞ起動
Private Sub ExecuteButchMode( _
                ByVal CatExePath As String, _
                ByVal EnvDirPath As String, _
                ByVal EnvPath As String, _
                ByVal MacroPath As String)
    Dim Cmd As String
    Cmd = CatExePath & " -direnv " & EnvDirPath & _
            " -env " & EnvPath & " -batch  -macro " & _
            Chr(34) & MacroPath & Chr(34)
    Call CreateObject("Wscript.Shell").Exec(Cmd)
End Sub

'CatVbsｿｰｽ
Private Function CreateCatvbsSource( _
                ByVal ReadPath As String, _
                ByVal SurfPath As String, _
                ByVal SolidPath As String, _
                ByVal MacroPath As String, _
                ByVal MSBO As Long) As String
    Dim ArySurf As Variant: ArySurf = KCL.SplitPathName(SurfPath)
    Dim ArySolid As Variant: ArySolid = KCL.SplitPathName(SolidPath)
    Dim Msg As String
    Msg = "[" & ArySurf(0) & "] に" & _
        "[" & ArySurf(1) & "." & ArySurf(2) & "] と" & _
        "[" & ArySolid(1) & "." & ArySolid(2) & "] を作成しました"

    CreateCatvbsSource = _
    "Sub CATMain()" & vbNewLine & _
    "    FullPath = " & Chr(34) & ReadPath & Chr(34) & vbNewLine & _
    "    SurfPath = " & Chr(34) & SurfPath & Chr(34) & vbNewLine & _
    "    SolidPath = " & Chr(34) & SolidPath & Chr(34) & vbNewLine & _
    "    IgsMSBO = " & CStr(MSBO) & vbNewLine & _
    "    Call ExpIges(FullPath, SurfPath, SolidPath, IgsMSBO)" & vbNewLine & _
    "    Call CATIA.Quit" & vbNewLine & _
    "    Set Fso = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbNewLine & _
    "    Call Fso.DeleteFile(" & Chr(34) & MacroPath & Chr(34) & ", True)" & vbNewLine & _
    "    Msgbox " & Chr(34) & Msg & Chr(34) & vbNewLine & _
    "End Sub" & vbNewLine & _
    "Private Sub ExpIges(ByVal ReadPath, ByVal SurfPath, ByVal SolidPath, ByVal MSBO)" & vbNewLine & _
    "    Set PDoc = CATIA.Documents.Open(CStr(ReadPath))" & vbNewLine & _
    "    Set IgsSetAtt = CATIA.SettingControllers.Item(" & Chr(34) & "CATIdeIgesSettingCtrl" & Chr(34) & ")" & vbNewLine & _
    "    IgsSetAtt.ExportMSBO = 0" & vbNewLine & _
    "    Call PDoc.ExportData(SurfPath, " & Chr(34) & "igs" & Chr(34) & ")" & vbNewLine & _
    "    IgsSetAtt.ExportMSBO = 1" & vbNewLine & _
    "    Call PDoc.ExportData(SolidPath, " & Chr(34) & "igs" & Chr(34) & ")" & vbNewLine & _
    "    IgsSetAtt.ExportMSBO = MSBO" & vbNewLine & _
    "End Sub"
End Function

・ﾊﾞｯﾁﾓｰﾄﾞのCATIAを起動し、ｱｸﾃｨﾌﾞなCATPartをそちらでも開く為
　保存しておく必要が有ります。
　（ﾏｸﾛ実行中に確認・上書き保存は可能です）

・処理後は、ｱｸﾃｨﾌﾞなCATPartﾌｧｲﾙと同一ﾌｫﾙﾀﾞ内に
　[ｱｸﾃｨﾌﾞなCATPartﾌｧｲﾙ] + [_Surface.igs]
　[ｱｸﾃｨﾌﾞなCATPartﾌｧｲﾙ] + [_Solid.igs]
　の二つのﾌｧｲﾙが出来上がります。

・変換後のﾌｧｲﾙ名が重複するものになる場合は、
　ﾌｧｲﾙ名の最後に [_(数字)] が付いたﾌｧｲﾙとなります。
　（上書きしません）

・一時的にcatvbsﾌｧｲﾙが作成されますが、処理後は削除します。

・ﾊﾞｯﾁﾓｰﾄﾞ起動を利用している為、小さなﾌｧｲﾙは逆に遅いです･･･。

GUI起動の場合、CATIAは二個までの制限(同一ﾘﾘｰｽの場合)があると
思うのですが、ﾊﾞｯﾁﾓｰﾄﾞ起動の場合はﾒﾓﾘの許す限り起動出来そうな
雰囲気があります。二つ起動した方が早いかも。

又、こちらの記載もﾊﾞｯﾁﾓｰﾄﾞ起動で解決出来るかな?
DrawをPDFでｴｸｽﾎﾟｰﾄ (未解決) - C#ATIA

ThickOnTheFly1

こちらでｸﾘｯｸした際、肉厚を取得しました。
ｸﾘｯｸした面に3Dな矢印と注記を作る - C#ATIA

こちらの方法を流用して
ﾎﾞﾃﾞｨの外側をﾏｸﾛで判断する - C#ATIA

動的に肉厚を取得できないかなぁ？　と思い挑戦中です。

画面左下のｽﾃｰﾀｽﾊﾞｰの位置に、測定した肉厚の値を表示させています。
ﾏｳｽｶｰｿﾙの動きにあわせて、2つの点がﾎﾞﾃﾞｨ上を動き回っています。
この2点の距離を肉厚として表示させています。

UpdateObjectとComputeの違い

こちらで教えて頂いた、Computeﾒｿｯﾄﾞ
UpdateとUpdateObject - C#ATIA

こちらで試した際は気が付かなかったのですが、
スピードテスト5 - C#ATIA

PartｸﾗｽのUpdateObjectﾒｿｯﾄﾞは各HybridShapeｸﾗｽのComputeﾒｿｯﾄﾞを
呼び出しているだけなのかな?　と思っていたのですが、
ちょっと違うようなのでご紹介。

こちらの画像のようなﾃﾞｰﾀで、交差ｺﾏﾝﾄﾞを実行します。

手動であれば、もちろん失敗します。

そこで、こちらのｺｰﾄﾞを実行します。

'vba Test_Update_errer
Sub CATMain()
    '準備
    Dim Pt As Part: Set Pt = CATIA.ActiveDocument.Part
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Hb As HybridBody: Set Hb = Pt.HybridBodies.Item(1)
    
    '二つの面のﾘﾌｧﾚﾝｽ
    Dim Ref1 As Reference: Set Ref1 = Pt.CreateReferenceFromGeometry(Hb.HybridShapes.Item(1))
    Dim Ref2 As Reference: Set Ref2 = Pt.CreateReferenceFromGeometry(Hb.HybridShapes.Item(2))
    
    '交差　未ｱｯﾌﾟﾃﾞｰﾄ状態
    Dim Intersect As HybridShapeIntersection
    Set Intersect = Fact.AddNewIntersection(Ref1, Ref2)
    Intersect.PointType = 0
    
    '更新ﾃｽﾄ
    Dim Msg$: Msg = ""
    
    On Error GoTo ExitUpdeteTest
        'Compute
        Msg = "Computeでｴﾗｰ"
        'Hb.AppendHybridShape Intersect
        Call Intersect.Compute
        
        'UpdateObject
        Msg = "UpdateObjectでｴﾗｰ"
        Call Pt.UpdateObject(Intersect)
    On Error GoTo 0
    
    Msg = "ｴﾗｰなし"

ExitUpdeteTest:
    MsgBox Msg
End Sub

実行結果はこちら

Computeﾒｿｯﾄﾞは、失敗していてもｴﾗｰを吐き出さないんです。
ｺﾒﾝﾄ化している部分を外し、形状ｾｯﾄに挿入後でも同様です。

確実に処理が成功しない場合は、ちょっと危険か香りがします。

ﾎﾞﾃﾞｨの外側をﾏｸﾛで判断する

以前、3次元測定機の測定結果(CSV)をCATIAに取り込み、
実物とCADﾃﾞｰﾀを差を調整しながらﾓﾃﾞﾘﾝｸﾞを行った事があったのですが、
大量の点をｲﾁｲﾁ測定する手間が非現実的なため、誤差を測定する為の
ﾏｸﾛを作成し作業をしたことが有ります。

単に 点 - ﾎﾞﾃﾞｨ 間の距離を測定するだけであれば、こちらの方法で
良いのですが、(ﾘﾌｧﾚﾝｽさえ取得できれば、何でも同じです)
ﾎﾞﾃﾞｨ - ﾎﾞﾃﾞｨ の最短距離の測定3 - C#ATIA

測定点がCADﾃﾞｰﾀに比べ 小さいのか?　大きいのか?
を判断する方法が最初はわかりませんでした。

ｲﾛｲﾛと試しているうちにわかったのですが、ﾎﾞﾃﾞｨとﾎﾞﾃﾞｨ内に
含まれている点の距離を測定した場合、
ﾊﾟｰﾄﾃﾞｻﾞｲﾝﾌｭｰﾁｬｰ(ﾊﾟｯﾄﾞ等)と点の距離を測定すると "0" となり
ﾎﾞﾃﾞｨの表面と点の距離を測定すれば、実際に離れている距離が
得られます。

実際に、これをﾏｸﾛ化することでOKでした。

'vba sample_IsInBox
'ﾎﾞﾃﾞｨ表面上は外側に判断

Option Explicit

Sub CATMain()

    '必要なもの
    Dim PDoc As PartDocument: Set PDoc = CATIA.ActiveDocument
    Dim Pt As Part: Set Pt = PDoc.Part
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    
    '点
    Dim Pnt As HybridShapePointCoord
    Set Pnt = Pt.HybridBodies.Item(1).HybridShapes.Item(1)
    
    '点ﾘﾌｧﾚﾝｽ
    Dim PntRef As Reference
    Set PntRef = Pt.CreateReferenceFromGeometry(Pnt)
    
    'ﾊﾟｰﾂﾎﾞﾃﾞｨ
    Dim Bd As Body: Set Bd = Pt.MainBody
    
    'ﾊﾟｰﾂﾎﾞﾃﾞｨの最後のﾊﾟｰﾄﾃﾞｻﾞｲﾝﾌｭｰﾁｬｰ
    Dim LastShape As Shape
    Set LastShape = Bd.Shapes.Item(Bd.Shapes.Count)
    
    'ﾌｭｰﾁｬｰのﾘﾌｧﾚﾝｽ
    Dim ShapeRef As Reference
    Set ShapeRef = Pt.CreateReferenceFromGeometry(LastShape)
    
    '抽出(ｻｰﾌｪｽ)したﾘﾌｧﾚﾝｽ
    Dim SurfRef As Reference
    Set SurfRef = CreateExtractRef(Pt, Fact, ShapeRef)
    
    '点とﾌｭｰﾁｬｰの距離
    Dim ShapeLng As Double
    ShapeLng = GetMaximumLength(Pt, PntRef, ShapeRef)
    
    '点と抽出の距離
    Dim SurfLng As Double
    SurfLng = GetMaximumLength(Pt, PntRef, SurfRef)
    
    '判断
    Dim Msg As String
    Msg = Pnt.Name & "は、" & Bd.Name & "の" & _
          IIf(ShapeLng = SurfLng, "外", "内") & _
          "側にあります"
    MsgBox Msg
    
    Call Fact.DeleteObjectForDatum(SurfRef)
End Sub

'抽出
Private Function CreateExtractRef( _
                    ByVal Pt As Part, _
                    ByVal Fact As HybridShapeFactory, _
                    ByVal Ref As Reference) As Reference
    Dim HSExt As HybridShapeExtract
    Set HSExt = Fact.AddNewExtract(Ref)
    With HSExt
        .PropagationType = 3
        .ComplementaryExtract = False
        .IsFederated = False
        .Compute
    End With
    
    Set CreateExtractRef = Pt.CreateReferenceFromGeometry(HSExt)
End Function

'最短距離測定
Private Function GetMaximumLength(ByVal Pt As Part, _
                                  ByVal Ref1 As Reference, _
                                  ByVal Ref2 As Reference) As Double
    GetMaximumLength = Pt.Parent.GetWorkbench("SPAWorkbench") _
                         .GetMeasurable(Ref1) _
                         .GetMinimumDistance(Ref2)
End Function

表面のﾘﾌｧﾚﾝｽを得る為に、"抽出" を利用しましたが、座標変換(同じ座標系)・
移動（移動量0）・回転・ｽｹｰﾘﾝｸﾞ・・・・何でも構わないと思います。

こんな感じで、原点を重心とした□100のﾎﾞﾃﾞｨと点が存在するﾃﾞｰﾀを
想定しています。

実行した感じはこちら。

これ自体は無意味ですが、判断は出来ています。

こちらのｺﾒﾝﾄ部分に、ﾁﾗｯと書いたのですが、
UpdateとUpdateObject - C#ATIA
この方法を利用すれば、ﾎﾞﾃﾞｨに限りどちらが外側にｵﾌｾｯﾄ
されるのかを判断する事が可能です。

余談ですが、3次元ｽｷｬﾅ等から得たﾃﾞｰﾀとCADﾃﾞｰﾀの差を見ることが
出来るﾌﾘｰｿﾌﾄはこちらで入手可能です。
GOM Inspect

スピードテスト5

一応、こちらの続きです。
http://kantoku.hatenablog.com/entry/2015/04/15/195513

前回のｺﾒﾝﾄで、"HybridShapeｸﾗｽのComputeﾒｿｯﾄﾞでもｱｯﾌﾟﾃﾞｰﾄ出来るよ" と
imihitoさんに教えていただき、少し速くなりそうな気がしたので、
こちらのｺｰﾄﾞを元に試してみました。
http://kantoku.hatenablog.com/entry/2015/04/11/172004

元のｺｰﾄﾞが32bitだった為、ﾃｽﾄが手軽に行えるようにしつつ
64bit用に修正しました。

'VBA Speed_Test using-'ver0.0.10'
Option Explicit

Private Const Max = 500         '点の生成数
Private Const TestCount = 5&    'ﾃｽﾄ回数

Sub CATMain()
    Debug.Print "*** start ***"
    
    Dim i&, PDoc As PartDocument
    For i = 1 To TestCount
        Set PDoc = CATIA.Documents.Add("Part")
        
        KCL.SW_Start
        Call SubCreateDatumPoint
        Debug.Print KCL.SW_GetTime & "秒"
        
        Call PDoc.Close
    Next
End Sub

Private Sub SubCreateDatumPoint()
    Dim oPart As MECMOD.Part
    Dim oHybShpFact As HybridShapeTypeLib.HybridShapeFactory
    Dim oHybBdy As MECMOD.HybridBody
    Dim oHybShpPt 'As HybridShapeTypeLib.HybridShapePointCoord
    Dim oHybShpPtExp As HybridShapeTypeLib.HybridShapePointExplicit
    Dim i As Integer
    Dim oPt As Variant
    Dim colMyObj1 As Collection
    Dim oMyobj As Object
    
    Set oPart = CATIA.ActiveDocument.Part
    Set oHybShpFact = oPart.HybridShapeFactory

    Set colMyObj1 = New Collection

'------------ Add Body ------------------------------
    Set oHybBdy = oPart.HybridBodies.Add()

'------------ Create RefPoint ------------------------------
    oPt = Array(0, 0, 0)
    Set oHybShpPt = oHybShpFact.AddNewPointCoord(oPt(0), oPt(1), oPt(2))
    Call oHybBdy.AppendHybridShape(oHybShpPt)
    Call oPart.UpdateObject(oHybShpPt)

'------------ Create DetumPoints ------------------------------
    For i = 1 To 500
        oPt(0) = oPt(0) + 10
        Call oHybShpPt.SetCoordinates(oPt)
        Call oPart.UpdateObject(oHybShpPt)
        Set oHybShpPtExp = oHybShpFact.AddNewPointDatum(oHybShpPt)
        Call colMyObj1.Add(oHybShpPtExp)
    Next
'------------ Append DetumPoints ------------------------------
    With oHybBdy
        For Each oMyobj In colMyObj1
            Call .AppendHybridShape(oMyobj)
        Next
    End With
    Call oHybShpFact.DeleteObjectForDatum(oHybShpPt)    'Delete RefPoint
    Call oPart.Update
    
    Set colMyObj1 = Nothing
End Sub

SubCreateDatumPoint関数は前回のままで、KCLは単に時間の測定に利用している
だけです。　結果はこちら。

*** start ***
1.191秒
1.195秒
1.195秒
1.195秒
1.193秒

32bit当時は、1.6～1.7秒程だったので64bitの恩恵を受けているようです。

見直したところ、SubCreateDatumPoint関数をこんな感じに修正すると
更に時間が短縮できそうだとわかりました。

Private Sub SubCreateDatumPoint()
    Dim Pt As Part: Set Pt = CATIA.ActiveDocument.Part
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory

'------------ Add Body ------------------------------
    Dim HBdy As HybridBody: Set HBdy = Pt.HybridBodies.Add()

'------------ Create RefPoint ------------------------------
    Dim Pos As Variant: Pos = Array(0#, 0#, 0#)
    Dim Pnt As Variant: Set Pnt = Fact.AddNewPointCoord(Pos(0), Pos(1), Pos(2))

'------------ Create DetumPoints ------------------------------
    Dim Ary() As HybridShapePointExplicit: ReDim Ary(Max) As HybridShapePointExplicit
    Dim i As Long
    
    For i = 1 To Max
        Pos(0) = Pos(0) + 10#
        Call Pnt.SetCoordinates(Pos)
        Call Pt.UpdateObject(Pnt)
        Set Ary(i) = Fact.AddNewPointDatum(Pnt)
    Next
    
'------------ Append DetumPoints ------------------------------
    For i = 1 To Max
        Call HBdy.AppendHybridShape(Ary(i))
    Next
    Call Fact.DeleteObjectForDatum(Pnt)
    Call Pt.UpdateObject(HBdy)
End Sub

変数名等も修正してしまいましたが、主に
・最初のRefPoint作成時、更新しない
・ｺﾚｸｼｮﾝ　→　配列化
・Partﾌｧｲﾙのｱｯﾌﾟﾃﾞｰﾄ　→　形状ｾｯﾄのｱｯﾌﾟﾃﾞｰﾄ
です。　結果はこちら

*** start ***
1.02秒
1.021秒
1.015秒
1.01秒
1.014秒

"ｷｰ付きｺﾚｸｼｮﾝ" も試しましたが、配列の方が少しだけ速い気がしました。
0.1秒強の短縮ですが、一番効果を感じたのは、
"Partﾌｧｲﾙのｱｯﾌﾟﾃﾞｰﾄ　→　形状ｾｯﾄのｱｯﾌﾟﾃﾞｰﾄ"
でした。

ここで本題の "Computeメソッド" です。利用出来そうなのが
RefPointの座標値書き換え後のｱｯﾌﾟﾃﾞｰﾄ時のみです。

　・・・
'------------ Create DetumPoints ------------------------------
    Dim Ary() As HybridShapePointExplicit: ReDim Ary(Max) As HybridShapePointExplicit
    Dim i As Long
    
    For i = 1 To Max
        Pos(0) = Pos(0) + 10#
        Call Pnt.SetCoordinates(Pos)
        Call Pnt.Compute 'ここだけ書き換え
        Set Ary(i) = Fact.AddNewPointDatum(Pnt)
    Next
　・・・

結果はこちら。

*** start ***
1.017秒
1.024秒
1.018秒
1.019秒
1.016秒

処理量が少ないので、誤差ﾚﾍﾞﾙの違いしか感じません・・・。

個人的には点・線・面等を作成する関数化させるのですが、
ｱｯﾌﾟﾃﾞｰﾄしたい為だけに、Partｸﾗｽを引数渡しする場合が
多々あります。　それが不要になるのは、かなりうれしい。

UpdateとUpdateObject

"ﾏｸﾛで作成した面の色を変更したけど、上手く反映されない"
と言った内容の御質問を頂きました。

このような状態のﾃﾞｰﾀで、ｵﾌｾｯﾄ面を作成する操作の
ﾏｸﾛを記録しました。

'vba
Sub CATMain()
    Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
    
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim parameters1 As Parameters
    Set parameters1 = part1.Parameters
    
    Dim hybridShapeSurfaceExplicit1 As HybridShapeSurfaceExplicit
    Set hybridShapeSurfaceExplicit1 = parameters1.Item("ｻｰﾌｪｽ.1")
    
    Dim reference1 As Reference
    Set reference1 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit1)
    
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory
    
    Dim hybridShapeOffset1 As HybridShapeOffset
    Set hybridShapeOffset1 = hybridShapeFactory1.AddNewOffset(reference1, 5#, True, 0.01)
    
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
    
    Dim hybridBody1 As HybridBody
    Set hybridBody1 = hybridBodies1.Item("形状ｾｯﾄ.1")
    
    hybridBody1.AppendHybridShape hybridShapeOffset1
    
    part1.InWorkObject = hybridShapeOffset1
    
    part1.Update
End Sub

色を変更する為の(手抜き感たっぷりな)関数をこんな感じで作成しました。

'色設定
Private Sub SetColor(ByVal Surf As HybridShapeOffset)
    With CATIA.ActiveDocument.Selection
        .Clear
        .Add Surf
        .VisProperties.SetRealColor 0, 255, 0, 1
        .Clear
    End With
End Sub

引数に渡されたｵﾌｾｯﾄなｵﾌﾞｼﾞｪｸﾄを緑色に変更するだけです。

問題は、このSetColor関数をCatMainの何処に記載するか？　です。

一番問題ないのが、一番最後の位置です。

	・・・
    hybridBody1.AppendHybridShape hybridShapeOffset1
    
    part1.InWorkObject = hybridShapeOffset1
    
    part1.Update
    
    Call SetColor(hybridShapeOffset1) '追加
End Sub

御質問頂いた方の場合は、こんな感じのｺｰﾄﾞでした。

	・・・
    hybridBody1.AppendHybridShape hybridShapeOffset1
    
    part1.InWorkObject = hybridShapeOffset1
    
    Call SetColor(hybridShapeOffset1) '追加
    
    part1.Update
End Sub

ご本人も　"Updateの後に色の変更であれば可能" と言う認識は
されておりました。

そこでちょっと意地悪く、こんなｺｰﾄﾞにしてみます。

	・・・
    'hybridBody1.AppendHybridShape hybridShapeOffset1 'ｺﾒﾝﾄ化
    
    part1.InWorkObject = hybridShapeOffset1
    
    part1.Update
    
    Call SetColor(hybridShapeOffset1) '追加
    
    hybridBody1.AppendHybridShape hybridShapeOffset1 '追加
    
    part1.Update

ｱｯﾌﾟﾃﾞｰﾄ後に色は変えるものの、形状ｾｯﾄに入れる（AppendHybridShape）
のは、後回しにします。　この場合、色は変更されませんでした。

この事から、
・色の変更は、ｱｯﾌﾟﾃﾞｰﾄ後に行う。
・ｱｯﾌﾟﾃﾞｰﾄする前に、形状ｾｯﾄに入れておく必要がある。
と言うことになりそうです。

そこで、このようなｺｰﾄﾞを提案してみました。

	・・・
    Dim hybridShapeOffset1 As HybridShapeOffset
    Set hybridShapeOffset1 = hybridShapeFactory1.AddNewOffset(reference1, 5#, True, 0.01)
    
    Call part1.UpdateObject(hybridShapeOffset1) '追加
    Call SetColor(hybridShapeOffset1) '追加
    
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
	・・・

ｵﾌｾｯﾄ面を作成（AddNewOffset）し、形状ｾｯﾄに入れる前に
UpdateObjectﾒｿｯﾄﾞでｱｯﾌﾟﾃﾞｰﾄし、色を変更する手順です。

UpdateObjectﾒｿｯﾄﾞであれば、Updateﾒｿｯﾄﾞと異なり、
形状ｾｯﾄに入れておく必要がありません。　

実はこの方法を利用すると、一時的に必要な要素を形状ｾｯﾄに入れる
必要が無くなる為、処理が非常に速くなります。
(場合によっては遅くなります)