曲線と戦ってみる2

最後にどなたかは忘れてしまいましたが、「このようにすれば、
もっと良いんじゃない？」と言うｺｰﾄﾞです。

'vbs - Type3
Option Explicit
Dim CATIA
Dim icd(500, 2), pnt_onCrv(500)
Dim icd1(2), icd2(2), icd3(2)
Dim centre(2), ng_arcCnt
Dim part1, Fact1, Hb1, Hb2

Dim m_ed        '前に成功した時の分割終点の番号
Dim n_circle    '生成される円弧の個数
Dim n_gencir    'プログラムの実行回数

Const bunkatu = 200
Const tole = 0.05

Sub Curve_Circle_3()
    On Error Resume Next
    Set CATIA = GetObject(, "CATIA.Application")
    ng_arcCnt = 0
    '---------------------------
    n_circle = 0
    n_gencir = 0
    '---------------------------
    Dim Doc, aSel, ret1, crv1
    Set Doc = CATIA.ActiveDocument
    Set aSel = Doc.selection
    Set part1 = Doc.Part
    Set Fact1 = part1.HybridShapeFactory
    Set Hb1 = part1.HybridBodies.add
    Dim InputObjectType(0)
    InputObjectType(0) = "HybridShape"
    aSel.Clear
    ret1 = aSel.SelectElement2(InputObjectType, "sel CRV", True)
    If (ret1 <> "Normal") Then Exit Sub
    Set crv1 = aSel.Item(1).Value
    aSel.Clear

    Dim i As Integer, ratio As Double, j As Integer
    Dim rad1 As Double
    Dim pnt1, origin(2)
    For i = 0 To bunkatu
        ratio = i / bunkatu
        Set pnt1 = Fact1.AddNewPointOnCurveFromPercent(crv1, ratio, False)
        Hb1.AppendHybridShape pnt1
        part1.Update
        Call pnt1.GetCoordinates(origin)
        For j = 0 To 2: icd(i, j) = origin(j): Next
        'Fact1.DeleteObjectForDatum (pnt1)
        Set pnt_onCrv(i) = pnt1
    Next
    part1.Update    '以上でicd(0 To bunkatu, 2)に座標値がｾｯﾄできた
    
    '------------------------------------------
    Set Hb2 = part1.HybridBodies.add
    '引数が１つ増えています
    Call gen_cir3(0, CInt(bunkatu), bunkatu)
    '------------------------------------------
    Call MsgBox("円弧を作れなかった部分は " & ng_arcCnt & " 箇所です。" _
        & vbCr & "円弧の数      : " & Str(n_circle) _
        & vbCr & "gen_cirの回数 : " & Str(n_gencir), vbMsgBoxSetForeground)
End Sub

'指定範囲内の近似作業
Sub gen_cir3(ByVal i_st As Integer, ByVal i_ed As Integer, ByVal inc As Integer)
                    'incは、次の分割点を決めるための増分
    If (2 > i_ed - i_st) Then
        If (1 = i_ed - i_st) Then
            ng_arcCnt = ng_arcCnt + 1
        End If
        Exit Sub '3点ないので計算不可
    End If
    '---------------------------
    n_gencir = n_gencir + 1
    '---------------------------
    Dim i_mid As Integer, j As Integer
    i_mid = Int((i_ed + i_st) / 2)
    For j = 0 To 2
        icd1(j) = icd(i_st, j): icd2(j) = icd(i_mid, j): icd3(j) = icd(i_ed, j)
    Next
    Dim rad1 As Double, ng_flg
    rad1 = rad_3Pkeisan 'centreも確定した
    If (0 < rad1) Then
        ng_flg = 0
        '間の点がtoleを外れたらng
        For j = i_st + 1 To i_ed - 1
            If (tole < Math.Abs(rad1 - cal_leng(icd(j, 0) - centre(0) _
                , icd(j, 1) - centre(1), icd(j, 2) - centre(2)))) Then
                    ng_flg = 1
                    Exit For
            End If
        Next
    Else
        ng_flg = 1
    End If
    '-----------------------------------------------
    inc = Int(inc / 2)    '増分を小さくする
    If (0 = ng_flg) Then
        '近似が成功した場合
        If inc = 0 Or i_ed = bunkatu Then
            '円弧を生成
            Call CreateCircle(i_st, i_mid, i_ed)
            '残り部分の近似作業
            inc = bunkatu - i_ed
            Call gen_cir3(i_ed, bunkatu, inc)   '再帰呼出
        Else
            '範囲を広げて再試行
            m_ed = i_ed
            Call gen_cir3(i_st, i_ed + inc, inc) '再帰呼出
        End If
    Else
        '近似が不成功の場合
        If inc = 0 Then
            '以前の円弧を生成
            i_ed = m_ed
            i_mid = Int((i_ed + i_st) / 2)
            Call CreateCircle(i_st, i_mid, i_ed)
            '残り部分の近似作業
            inc = bunkatu - i_ed
            Call gen_cir3(i_ed, bunkatu, inc)   '再帰呼出
        Else
            '範囲を狭めて再試行
            Call gen_cir3(i_st, i_ed - inc, inc) '再帰呼出
        End If
    End If
    '-----------------------------------------------
End Sub

'円弧を生成
Sub CreateCircle(ByVal i_st As Integer, ByVal i_md As Integer, ByVal i_ed As Integer)
    '---------------------------
    n_circle = n_circle + 1
    '---------------------------
    Dim arc1 'As HybridShapeCircle3Points
    Set arc1 = Fact1.AddNewCircle3Points(pnt_onCrv(i_st), pnt_onCrv(i_md), pnt_onCrv(i_ed))
    Hb2.AppendHybridShape arc1
    part1.Update
End Sub

'以下の部分は Type1と同じです

こちらのｺｰﾄﾞも基本的に、再帰のさせ方を変更したものですが
かなり複雑です。
Type1・2ではgen_cir関数としていたものが、Type3ではgen_cir3関数
と言う名称に変更され、引数の数が2→3に変更されています。

僕の解釈では、こんな感じです。
・円弧の評価する部分までは、Type1と同様です。
　但し、ﾄﾚﾗﾝｽ以内であっても円弧を生成しません。
　
・まず、成功した終点ｲﾝﾃﾞｯｸｽを予めｷｰﾌﾟしておきます。(変数m_ed)
f:id:kandennti:20160616081651p:plain
　
・成功した円弧より大きな範囲でも、ﾄﾚﾗﾝｽ以内になる可能性があるため
　二分探索木が逆行するように、未確定な部分の半分の位置を指定し
　再帰させます。
f:id:kandennti:20160616081658p:plain