C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

Drawの曲線をオフセットする

「Drawの曲線のオフセットをマクロで行いたい」との相談を頂きました。

Drawは非常に難しいです。
過去のこちらを流用し行おうとしていたようなのですが、
Drawingの直線を移動する2 - C#ATIA
こちらもすんなりと行ったものではない為、何ともならないのが本音です。

結果的に代案を考えました。作戦はこんな感じです。
・Drawの曲線をコピー
・ダミーPartを作成し、スケッチにペースト
・GSDとしてオフセット
・オフセットしたものをスケッチに投影(分離)
・投影したものをコピーし元のDrawにペースト
・ダミーPart削除
結果的にこれぐらいの遠回りなら可能そうだなぁ と思い作ってみました。

'vba sample_OffsetCurve2D  by Kantoku

Option Explicit

Sub CATMain()

    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As selection
    Set sel = doc.selection
    
    'ライン選択
    Dim filter As Variant
    filter = Array("Curve2D")
    
    Dim msg As String
    msg = "オフセットする曲線選択 // [Esc]=キャンセル"
    
    Dim Result
    Dim crv As Curve2D
    Dim selVri As Variant
    Set selVri = sel
    With selVri
        .Clear
        Result = .SelectElement2(filter, msg, False)
        If Result = "Cancel" Then Exit Sub
        Set crv = .Item(1).Value
        .Clear
    End With
    
    'オフセット量入力
    Dim offsetStr As String
    msg = "オフセット量を入力してください // 空白=キャンセル"
    offsetStr = InputBox(msg)
    
    'キャンセルチェック
    If offsetStr = vbNullString Then MsgBox "キャンセル": End
    
    '入力値チェック
    If Not IsNumeric(offsetStr) Then
        msg = "入力形式が不正です。" + vbCrLf
        msg = msg + "オフセット量を正しく入力してください"
        MsgBox msg, vbOKOnly + vbInformation
        Exit Sub
    End If
    
    Dim offVal As Double
    offVal = CDbl(offsetStr)
    
    'crvの所属ビュー取得
    Dim vi As DrawingView
    Set vi = crv.Parent.Parent
    
    'crvコピー
    With sel
        .Clear
        .Add crv
        .Copy
        .Clear
    End With
    
    'ダミーPart作成
    Dim tmpDoc As PartDocument
    Set tmpDoc = CATIA.Documents.Add("Part")

    Dim pt As part
    Set pt = tmpDoc.part
    
    '形状セット作成
    Dim hbdy As HybridBody
    Set hbdy = pt.HybridBodies.Add()
    
    'スケッチ作成
    Dim xyRef As Reference
    Set xyRef = pt.CreateReferenceFromObject(pt.OriginElements.PlaneXY)
    
    Dim skt As Sketch
    Set skt = hbdy.HybridSketches.Add(xyRef)
    
    'ペースト
    Dim tmpSel As selection
    Set tmpSel = tmpDoc.selection
    
    Dim fact2D As Factory2D
    Set fact2D = skt.OpenEdition()
    
    With tmpSel
        .Clear
        .Add skt.AbsoluteAxis.Origin
        .Paste
        .Clear
    End With
    
    skt.CloseEdition
    pt.Update
    
    'GSDとしてオフセット
    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory
    
    Dim sktRef As Reference
    Set sktRef = pt.CreateReferenceFromObject(skt)
    
    Dim crvPar As HybridShapeCurvePar
    Set crvPar = fact.AddNewCurvePar(sktRef, Nothing, offVal, False, False)
    Call pt.UpdateObject(crvPar)
    
    Dim crvParRef As Reference
    Set crvParRef = pt.CreateReferenceFromObject(crvPar)
    
    'スケッチ作成
    Set skt = hbdy.HybridSketches.Add(xyRef)
    
    'オフセット投影
    Set fact2D = skt.OpenEdition()
    
    Dim prj2D As Geometry2D
    Set prj2D = skt.Factory2D.CreateProjection(crvParRef)
    pt.Update
    
    '分離
    With tmpSel
        .Clear
        .Add prj2D
    End With
    
    'CATIA.StartCommand ("Isolate")'英語
    CATIA.StartCommand ("分離") '日本語
    
    '分離後コピー
    With tmpSel
        .Clear
        .Add skt.GeometricElements.Item(skt.GeometricElements.Count)
        .Copy
        .Clear
    End With
    
    skt.CloseEdition
    
    '元のビューにペースト
    doc.Activate
    
    With sel
        .Clear
        .Add vi
        .Paste
        sel.VisProperties.SetRealColor 0, 0, 0, 1 '線を黒にする
        .Clear
    End With
    
    doc.Update
    
    'ダミーPart放棄
    tmpDoc.Close
    
    '終わり
    MsgBox "Done"
    
End Sub

あまり好きじゃないのですが、CATMainのみとしました。
その為、変数を使いまわしている部分もあり、途中だけ読むと理解しにくい
可能性が高いです。

又、オフセットする際どちら側がプラス方向かどうかは、描いた曲線の
始点終点の関係に依存しており、マクロ側では ”どちらが正しいか?” は
判断出来ない要素です。(正解はマクロの使用者のみが知っています)
その為、使い勝手が悪い可能性が高く、ボツになるのではないかと思われます。