C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

2D曲線の折れ線化 - 円弧

過去に作った2Dの重複線削除マクロを修正して、再度Upする意欲が
出て来たので、しばらくはこれに取り組みたいと思っています。

昔のコードに4分木を適用するのが結構面倒な事になりそうな為、
ほぼ作り直しです。


当時、重複線を判断する際、直線・円弧は何となく出来そうな
気がしていたのですが、スプラインについてはどの様に判断すれば
良いのかわかりませんでした。
結局、思いついたのは全て折れ線として変換し、直線と点同士
であれば、重複を判断出来そうだなぁと思い折れ線化の方法で
作りました。

以前の円弧→折れ線のコードを修正しテストしてみました。
選択する円弧は、3DからリンクしたものはNGです。

'vba test_Circle2Polyline  using-'KCL0.09'
'2D円弧の折れ線化

Option Explicit

'*** 設定 ***
Private Const m_PolyTol = 0.1 '折れ線化トレランス
'************

Sub CATMain()
    'ドキュメントのチェック
    If Not KCL.CanExecute("DrawingDocument") Then Exit Sub
    
    '選択
    Dim Geo As Circle2D
    Set Geo = KCL.SelectItem("選択", "Circle2D")
    If KCL.IsNothing(Geo) Then Exit Sub
    
    '折れ線座標郡取得
    Dim PolyList As Collection: Set PolyList = Circle2Poly(Geo)
    If KCL.IsNothing(PolyList) Then Exit Sub
    
    '点・線作成
    Dim View As DrawingView: Set View = KCL.GetParent_Of_T(Geo, "GeometricElements")
    Call DumpPnt2D(PolyList, View.Factory2D)
    Call DumpPoly2D(PolyList, View.Factory2D)
End Sub

'円弧折れ線化
Private Function Circle2Poly(Geo As AnyObject) As Collection
    Set Circle2Poly = Nothing
    '円弧情報
    Dim Pos(1) '始点終点パラメータ
    Dim StPos(1) '始点座標
    Dim EnPos(1) '終点座標
    Dim CnPos(1) '中心座標
    Dim R# '半径
    Dim Lng# '長さ
    
    With Geo
        Call .GetParamExtents(Pos)
        Call .GetPointAtParam(Pos(0), StPos)
        Call .GetPointAtParam(Pos(1), EnPos)
        Call .GetCenter(CnPos)
        R = .Radius
        Lng = .GetLengthAtParam(Pos(0), Pos(1))
    End With
    
    'トレランス内の増分パラメータ算出
    Dim IncPara As Double 'パラメータ増分
    Dim E_SPara As Double '終点-始点パラメータ
    Dim LoopCount As Integer 'カウンタ
    If R * 0.5 < m_PolyTol Then
        '小さな円弧への対応
        IncPara = (Pos(1) - Pos(0)) * 0.5
    Else
        '通常の円弧
        IncPara = ArcCos(1 - m_PolyTol / R) * 2
        E_SPara = Pos(1) - Pos(0)
        LoopCount = Fix(E_SPara / IncPara) + 1
        IncPara = E_SPara / LoopCount
    End If
    
    '増分の三角関数
    Dim SinTheta#, CosTheta#
    SinTheta = Sin(IncPara)
    CosTheta = Cos(IncPara)
    
    '折れ線化
    Dim AD As Double, BD As Double '回転前の点と中心点の距離
    Dim PntList As Collection: Set PntList = New Collection
    Dim i&
    Call PntList.Add(Array(StPos(0), StPos(1)))
    For i = 2 To LoopCount
        AD = PntList(i - 1)(0) - CnPos(0)
        BD = PntList(i - 1)(1) - CnPos(1)
        Call PntList.Add(Array(AD * CosTheta - BD * SinTheta + CnPos(0), _
                               AD * SinTheta + BD * CosTheta + CnPos(1)))
    Next
    Call PntList.Add(Array(EnPos(0), EnPos(1)))
    Set Circle2Poly = PntList
End Function

'ArcCos
Private Function ArcCos(ByVal V As Double) As Double
    ArcCos = Atn(-V / Sqr(-V * V + 1)) + 2 * Atn(1)
End Function

'確認用
'2D点
Private Sub DumpPnt2D(ByVal List As Collection, ByVal Fact As Factory2D)
    Dim Pos, P As Point2D
    For Each Pos In List
        Set P = Fact.CreatePoint(Pos(0), Pos(1))
        P.ReportName = 3
        P.Construction = False
    Next
End Sub

'2D線
Private Sub DumpPoly2D(ByVal List As Collection, ByVal Fact As Factory2D)
    Dim i&, L As Line2D
    For i = 1 To List.Count - 1
        Set L = Fact.CreateLine(List(i)(0), List(i)(1), _
                                List(i + 1)(0), List(i + 1)(1))
    Next
End Sub

CATIAの機能として、曲線上に点を作成する事が可能なのですが
処理が遅い為、円弧情報から演算し指定トレランス以内で折れ線化出来る
座標値を求めています。
又、CATIAで2D円弧を書いた場合、通常は反時計回りになりますが
唯一ミラーした場合だけ時計回りとなります。

実際に試した感じです。
f:id:kandennti:20170106173919p:plain
こんな感じの円弧ですが、閉じた円弧でも大丈夫です。

f:id:kandennti:20170106173924p:plain
マクロ実行後は、トレランス以内となる点と直線を作ります。

f:id:kandennti:20170106173930p:plain
拡大してみると、オレンジが元の円弧で黒がマクロで作成した点と線です。

f:id:kandennti:20170106173934p:plain
上記のコードはトレランス0.1mmとしていたので、円弧を両側0.1mmオフセット
したものが青色です。画像は点と点の中間付近の一番トレランスから
外れやすい部分ですが、トレランス以内で折れ線化出来ています。


改めてコードを見た際、 "何でこんな計算式なのだろう?" と
思ったのですが、Sin Cosの計算回数を減らす為にこんな式にした
ようです。(本人が忘れています…)