「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のみとしました。
その為、変数を使いまわしている部分もあり、途中だけ読むと理解しにくい
可能性が高いです。
又、オフセットする際どちら側がプラス方向かどうかは、描いた曲線の
始点終点の関係に依存しており、マクロ側では ”どちらが正しいか?” は
判断出来ない要素です。(正解はマクロの使用者のみが知っています)
その為、使い勝手が悪い可能性が高く、ボツになるのではないかと思われます。