方向反転判断しながら平行曲線作成

"GSDのサポートを指定した平行曲線ﾏｸﾛが上手く行かない" とご相談頂きました。
こんな感じでしょうか？

まず、実際にﾏｸﾛの記録を取ってみます。

'catvba
Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 As hybridBodies
Set hybridBodies1 = part1.hybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("形状ｾｯﾄ.1")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapeExtract1 As HybridShapeExtract
Set hybridShapeExtract1 = hybridShapes1.Item("抽出.1")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName("BorderREdge:(BEdge:(Brp:(FeatureRSUR.1;(Brp:(Pad.1;0:(Brp:(Sketch.1;3)));Brp:(Pad.1;2)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeExtract1)

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeExtract1)

Dim hybridShapeCurvePar1 As HybridShapeCurvePar
Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)

hybridShapeCurvePar1.SmoothingType = 0

hybridBody1.AppendHybridShape hybridShapeCurvePar1

part1.InWorkObject = hybridShapeCurvePar1

part1.Update

End Sub

細かくﾁｪｯｸしているのが面倒な為、個人的には記録をとったﾏｸﾛを再実行します。
同様の結果になれば、全て記録されている目安になります。

これ全てが欲しい訳ではなく、実際に欲しい部分は、こちらの3行です。

Dim hybridShapeCurvePar1 As HybridShapeCurvePar
Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)

hybridShapeCurvePar1.SmoothingType = 0

個人的には問題を切り分けたい為、この平行曲線を作成するだけの関数を作成します。

Private Function InitCurvePar(xxxx) As HybridShapeCurvePar
    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

出来上がった平行曲線のﾘﾌｧﾚﾝｽを取得し戻り値とするのも方法ですが、とりあえず
ｵﾌﾞｼﾞｪｸﾄそのものを返すことにしました。
xxxx部分は必要となる引数です。必要となるものは "Set hybridShapeCurvePar1～"
の行に比較的有ります。
・hybridShapeFactory1
・reference1
・reference2
・7#（距離）
この辺でしょうか。

これらを引数としますが、"reference1" の名称ではあまりにも意味がわかりにくいため
それなりの名称に変更します。

Private Function InitCurvePar(ByVal part1 As Part, _
                              ByVal edgeRef As Reference, _
                              ByVal supportRef As Reference, _
                              ByVal leng As Double) As HybridShapeCurvePar
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(edgeRef, supportRef, leng, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    part1.UpdateObject hybridShapeCurvePar1
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

ﾏｸﾛの記録をとった場合は、"part1.Update" で記録されますが、
"part1.UpdateObject"　の方が処理も軽いですし、他のｴﾗｰの影響も受けません。
（手動のﾛｰｶﾙ更新と同等です）

質問者さんが悩まれているのは、ここからです。
実際はｵﾌｾｯﾄ方向がｻﾎﾟｰﾄ上にならない場合があります。
そのような場合、手動であれば "方向を反転" を押す事になりますよね？

HybridShapeCurveParｵﾌﾞｼﾞｪｸﾄを調べてみると、それっぽいﾌﾟﾛﾊﾟﾃｨが有ります。

英語わからないのですが、それっぽい事には気が付きます。

これを "On Error Resume Next" を利用しながら判断し処理するように
書き換えました。

Private Function InitCurvePar(ByVal part1 As Part, _
                              ByVal edgeRef As Reference, _
                              ByVal supportRef As Reference, _
                              ByVal leng As Double) As HybridShapeCurvePar
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(edgeRef, supportRef, leng, False, False)
    
    hybridShapeCurvePar1.SmoothingType = 0
    
    On Error Resume Next
        err.Number = 0
        part1.UpdateObject hybridShapeCurvePar1
        
        '反転
        If Not err.Number = 0 Then
            err.Number = 0
            hybridShapeCurvePar1.InvertDirection = True
            part1.UpdateObject hybridShapeCurvePar1
        End If
        
        '反転してもｴﾗｰの為、そもそも無理
        If Not err.Number = 0 Then
             Set hybridShapeCurvePar1 = Nothing
        End If
    On Error GoTo 0
    
    Set InitCurvePar = hybridShapeCurvePar1
End Function

同じ事を複数書いたりしてますが、わかりやすくする為にこのようにしました。
（個人的にはもっと書き直したいです）

この自作関数を呼び出す為に、最初に記録したﾏｸﾛをこんな感じで
書き換えます。

    ・・・

    Dim hybridShapeCurvePar1 As HybridShapeCurvePar
    'Set hybridShapeCurvePar1 = hybridShapeFactory1.AddNewCurvePar(reference1, reference2, 7#, False, False)
    
    'hybridShapeCurvePar1.SmoothingType = 0
    
    '自作関数処理
    Set hybridShapeCurvePar1 = InitCurvePar(part1, reference1, reference2, 7#)
    
    '両側失敗
    If hybridShapeCurvePar1 Is Nothing Then
        MsgBox "ｵﾌｾｯﾄ距離が思わしく有りません!"
        Exit Sub
    End If
    
    hybridBody1.AppendHybridShape hybridShapeCurvePar1
    
    part1.InWorkObject = hybridShapeCurvePar1
    
    part1.Update

End Sub

InitCurveParの4番目の引数を　"-7#" "1000#" 等試して頂ければ、それなりの
処理をしてくれます。

変数名もｲﾏｲﾁなのですが、とりあえず僕が進める手順はこの様な感じです。