こちらの続きです。
曲線と戦ってみる10 - C#ATIA
曲線内の最小Rとなる部分を見つけ出せば、何か糸口が掴めるかな?
と思っています。 指定した曲線の最小Rって "式" で取得できる事
知っていましたか?
こんな感じです。
"長さ" のパラメータを作成して、画像のような "式" を作ると取得可能です。
これも、"Unofficial CATIA User Forum" で、ここなさんが
書かれていたんですけどね。
"式" で利用できるのであれば、マクロでも利用できます。
ですが、困った事に最小Rのサイズは取得できるのですが、肝心な
"どの位置で?" が取得できないです。
そこで、何とか最小Rの位置に点を作成するマクロに挑戦してみました。
'vba using-'KCL' GetMinimumCurvatureRadiusPoint Option Explicit Private Const MinRange = 0.001 '最小Rを検出する範囲 Sub CATMain() '曲線選択 Dim Msg$: Msg = "曲線を選択して下さい : ESCキー 終了" Dim SelElem As SelectedElement Set SelElem = KCL.SelectElement(Msg, Array("HybridShape")) If KCL.IsNothing(SelElem) Then Exit Sub Dim CurveOj As AnyObject: Set CurveOj = SelElem.Value Dim CurveRef As Reference: Set CurveRef = SelElem.Reference '各種設定 Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(CurveRef, "PartDocument") Dim Pt As Part: Set Pt = Doc.Part Dim Sel As Selection: Set Sel = Doc.Selection CATIA.RefreshDisplay = False '曲線の全長取得 Dim CurveLength#: CurveLength = GetCurveLength(Pt, CurveRef) '最小Rとなる比率の範囲 Dim MinRangeRatio#: MinRangeRatio = MinRange / CurveLength '曲線全体に対しての最小R取得 Dim MinR_Param As Length: Set MinR_Param = InitParam_Len(Pt) Dim MinR_Formula As Formula: Set MinR_Formula = InitFormula(Pt, MinR_Param, CurveOj) Dim MinR#: MinR = MinR_Param.Value Call DelItem(Sel, Array(MinR_Formula, MinR_Param)) '作業用形状セット Dim HB As HybridBody: Set HB = Pt.HybridBodies.Add HB.Name = "temp" '比率初期設定 Dim Low#: Low = 0# Dim Mid#: Mid = 0.5 Dim High#: High = 1# 'トリム用点作成 Dim LowPnt As HybridShapePointOnCurve: Set LowPnt = InitPnt(Pt, CurveRef, Low) Dim LowRef As Reference: Set LowRef = Pt.CreateReferenceFromObject(LowPnt) Dim LowRatio As RealParam: Set LowRatio = LowPnt.Ratio Call HB.AppendHybridShape(LowPnt) Dim MidPnt As HybridShapePointOnCurve: Set MidPnt = InitPnt(Pt, CurveRef, Mid) Dim MidRef As Reference: Set MidRef = Pt.CreateReferenceFromObject(MidPnt) Dim MidRatio As RealParam: Set MidRatio = MidPnt.Ratio Call HB.AppendHybridShape(MidPnt) Dim HighPnt As HybridShapePointOnCurve: Set HighPnt = InitPnt(Pt, CurveRef, High) Dim HighRef As Reference: Set HighRef = Pt.CreateReferenceFromObject(HighPnt) Dim HighRatio As RealParam: Set HighRatio = HighPnt.Ratio Call HB.AppendHybridShape(HighPnt) '上下分割曲線 Dim LwrCrv As HybridShapeSplit: Set LwrCrv = InitSplit(Pt, CurveRef, LowRef, MidRef) Call HB.AppendHybridShape(LwrCrv) Dim UprCrv As HybridShapeSplit: Set UprCrv = InitSplit(Pt, CurveRef, MidRef, HighRef) Call HB.AppendHybridShape(UprCrv) '上下分割曲線に対しての最小R Dim Lwr_Param As Length: Set Lwr_Param = InitParam_Len(Pt) Dim Lwr_Formula As Formula: Set Lwr_Formula = InitFormula(Pt, Lwr_Param, LwrCrv) Dim Upr_Param As Length: Set Upr_Param = InitParam_Len(Pt) Dim Upr_Formula As Formula: Set Upr_Formula = InitFormula(Pt, Upr_Param, UprCrv) '二分探索木-非再帰 Dim MinR_Ratio# Do '十分な精度を満たしたか? If Not (High - Low) > MinRangeRatio Then MinR_Ratio = Mid Exit Do End If 'どっち? Select Case True Case Lwr_Param.Value = Upr_Param.Value If (High - Low) > MinRangeRatio * 3 Then Msg = "同一の最小Rとなる部分が、複数存在している可能性があります。" + vbNewLine _ + "出来上がった点を元に分割し、それぞれの曲線で再度実行することをお勧めします" MsgBox Msg, vbOKOnly + vbExclamation End If MinR_Ratio = Mid Exit Do Case Lwr_Param.Value < Upr_Param.Value High = Mid HighRatio.Value = High Case Lwr_Param.Value > Upr_Param.Value Low = Mid LowRatio.Value = Low End Select Mid = (Low + High) * 0.5 MidRatio.Value = Mid 'UpDete Dim UpDateFG As Boolean 'UpDateのエラー用 UpDateFG = UpDateAry(Pt, Array(MidRatio, MidPnt, _ LowRatio, LowPnt, LwrCrv, Lwr_Param, _ HighRatio, HighPnt, UprCrv, Upr_Param)) If Not UpDateFG Then MinR_Ratio = Mid Exit Do End If Loop '全て削除 Call DelItem(Sel, Array(Lwr_Formula, Upr_Formula, _ Lwr_Param, Upr_Param, _ LwrCrv, UprCrv, LowPnt, HighPnt)) '結果 HB.Name = "Result" Mid = MinR_Ratio Call UpDateAry(Pt, Array(MidRatio, MidPnt)) MidPnt.Name = CurveOj.Name + "_MinR-" + CStr(MinR) + _ " : Ratio-" + CStr(MinR_Ratio) CATIA.RefreshDisplay = True '終了 MsgBox "終了" End Sub '要素のUpDate 'Return:True-正常終了 False-エラー発生 Private Function UpDateAry(ByVal Pt As Part, ByVal Ary As Variant) As Boolean Dim i& UpDateAry = True For i = 0 To UBound(Ary) On Error GoTo Catch Call Pt.UpdateObject(Ary(i)) Next Exit Function Catch: '精度が過剰。この時点で十分求まっているはず UpDateAry = False End Function '曲線長さ取得 Private Function GetCurveLength#(ByVal Pt As Part, ByVal Ref As Reference) GetCurveLength = Pt.Parent.GetWorkbench("SPAWorkbench").GetMeasurable(Ref).Length End Function '要素の削除 Private Sub DelItem(ByVal Sel As Selection, ByVal Ary As Variant) Dim i& With Sel .Clear For i = 0 To UBound(Ary) .Add Ary(i) Next .Delete End With End Sub '分割 Private Function InitSplit(ByVal Pt As Part, ByVal CrvRef As Reference, _ ByVal FstRef As Reference, _ ByVal ScdRef As Reference) _ As HybridShapeSplit Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory Dim CrvSplit As HybridShapeSplit Set CrvSplit = Fact.AddNewHybridSplit(CrvRef, FstRef, -1) Call CrvSplit.AddCuttingElem(ScdRef, 1) Call Pt.UpdateObject(CrvSplit) Set InitSplit = CrvSplit End Function '曲線上の点 Private Function InitPnt(ByVal Pt As Part, ByVal CurveRef As Reference, _ Optional ByVal Ratio# = 0#) As HybridShapePointOnCurve Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory Dim Pnt As HybridShapePointOnCurve Set Pnt = Fact.AddNewPointOnCurveFromPercent(CurveRef, Ratio#, False) Call Pt.UpdateObject(Pnt) Set InitPnt = Pnt End Function 'パラメータ Private Function InitParam_Len(ByVal Pt As Part) As Length Set InitParam_Len = Pt.Parameters.CreateDimension("", "LENGTH", 0#) End Function '式 Private Function InitFormula(ByVal Pt As Part, ByVal Param As Length, _ ByVal AnyOj As AnyObject) As Formula Dim UseNameInRelation$ UseNameInRelation = Replace(Pt.Parameters.GetNameToUseInRelation(AnyOj), "`", "") Set InitFormula = Pt.Relations.CreateFormula( _ AnyOj.Name + "_MinR", _ "", _ Param, _ "minimumCurvatureRadius(`" + UseNameInRelation + "` ) ") End Function
もっと関数化すべき(カッコイイ言い方だとリファクタリング)かとは思ったのですが、
利用価値が微妙なのでそのままにしてます。
作戦としては、曲線を2本の分割し最小Rが存在している方を再度分割し・・・、
と、二分探索木で十分な精度まで探し出しています。
二分探索木については、こちらの問題があるため "非再帰" にしています。
曲線と戦ってみる5 - C#ATIA
実際に利用するとこんな感じです。・・・と言っても曲線を選択するだけです。
「曲線.1」を選択すると「Result」形状セットが作成されて点が1個作成されます。
点の名前は「指定した曲線名」-「最小Rサイズ」-「始点からの比率」
となっています。
念の為、確認してみます。
曲線がかなりうねっているのでゴチャゴチャですが、処理後の点付近を拡大すると
ナカナカの精度で出来ていると思います。
・・・でも、実際に利用するかなぁ?
昨夜見つけたこちらの動画。 何となくやっている事がこれに
近い感じがします。
"更新" アイコンのチラツキ加減が半端じゃないのですが、僕だったら
UpdateObjectにしちゃうんだけどなぁ。