タイトルが異なりますが、こちらの続きです。
クリックした面に法線を作成する - C#ATIA
こちらでコメント頂いている矢の部分ですが、
昨日自宅で、どの様な定義をすれば良いのか思いついたので
コードを作成してみました。
(このような事は案外、PCの前に居ない時に思いつきますね)
'vba sample_CreateArrow_ver0.0.1 using-'ver0.0.10' 'クリックした面に矢印を作成 Option Explicit Private Const ArwBodyLeng = 20# Private Const ArwLeng = 5# Private Const ArwAng = 30# Sub CATMain() 'ドキュメントのチェック If Not CanExecute(Array("PartDocument", "ProductDocument")) Then Exit Sub 'ユーザー選択 Dim Elm As Variant 'SelectedElement Set Elm = KCL.SelectElement("面を選択", "Face") If KCL.IsNothing(Elm) Then Exit Sub 'クリック座標取得 Dim Pos(2) As Variant 'Double Call Elm.GetCoordinates(Pos) '各必要なもの取得 Dim Pt As Part Set Pt = Elm.Document.Part Dim Fact As HybridShapeFactory Set Fact = Pt.HybridShapeFactory Dim DelList As Collection Set DelList = New Collection '選択面Ref Dim SurfRef As Reference Set SurfRef = Elm.Reference 'クリック位置の点 Dim PntRef As Reference Set PntRef = CreatePntRef(Pt, Fact, Pos) Call DelList.Add(PntRef) '向き確認用 Dim Rev As Boolean: Rev = False Dim Msg As String: Msg = "向きを逆転しますか?" Dim HBdy As HybridBody Do '法線 Dim LinRef As Reference Set LinRef = CreateNormalRef(Pt, Fact, SurfRef, PntRef, ArwBodyLeng, Rev) Call DelList.Add(LinRef) '線上の点 Dim PntOnRef As Reference Set PntOnRef = CreatePntOnCrvRef(Pt, Fact, LinRef, ArwLeng, Rev) Call DelList.Add(PntOnRef) '平面 Dim PlnRef As Reference Set PlnRef = CreatePlnRef(Pt, Fact, LinRef, PntRef) Call DelList.Add(PlnRef) '円弧 Dim Crl As HybridShapeCircleCtrRad Set Crl = CreateCrl(Pt, Fact, PntOnRef, PlnRef, ArwAng, ArwLeng) Call DelList.Add(Crl) '円弧端点 Dim SrtRef As Reference Set SrtRef = CreateEndPntRef(Pt, Fact, Crl, True) Call DelList.Add(SrtRef) Dim EndRef As Reference Set EndRef = CreateEndPntRef(Pt, Fact, Crl, False) Call DelList.Add(EndRef) '折れ線 Dim PlyRef As Reference Set PlyRef = CreatePlyRef(Pt, Fact, SrtRef, PntRef, EndRef) Call DelList.Add(PlyRef) '接合 Dim JoinRef As Reference Set JoinRef = CreateJoinRef(Pt, Fact, LinRef, PlyRef) Call DelList.Add(JoinRef) 'データム化 Dim Dtm As HybridShapeLineExplicit Set Dtm = ToDatum(Pt, Fact, JoinRef) '形状セット作成 If KCL.IsNothing(HBdy) Then Set HBdy = Pt.HybridBodies.Add() End If Call HBdy.AppendHybridShape(Dtm) '向き確認 If MsgBox(Msg, vbYesNo) = vbYes Then Call Fact.DeleteObjectForDatum(Dtm) Rev = IIf(Rev, False, True) Else Exit Do End If Loop 'ゴミ掃除 Dim Ref As Reference For Each Ref In DelList Call Fact.DeleteObjectForDatum(Ref) Next MsgBox "Done" End Sub '接合 Private Function CreateJoinRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal LinRef As Reference, _ ByVal PlyRef As Reference) As Reference Dim Join As HybridShapeAssemble Set Join = Fact.AddNewJoin(LinRef, PlyRef) With Join .SetConnex 1 .SetManifold 0 .SetSimplify 0 .SetSuppressMode 0 .SetDeviation 0.001 .SetAngularToleranceMode 0 .SetAngularTolerance 0.5 .SetFederationPropagation 0 End With Call Pt.UpdateObject(Join) Set CreateJoinRef = Pt.CreateReferenceFromObject(Join) End Function '折れ線 Private Function CreatePlyRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal Ref1 As Reference, _ ByVal Ref2 As Reference, _ ByVal Ref3 As Reference) As Reference Dim Ply As HybridShapePolyline Set Ply = Fact.AddNewPolyline() With Ply .InsertElement Ref1, 1 .InsertElement Ref2, 2 .InsertElement Ref3, 3 .Closure = False End With Call Pt.UpdateObject(Ply) Set CreatePlyRef = Pt.CreateReferenceFromObject(Ply) End Function '端点 Private Function CreateEndPntRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal Crl As HybridShapeCircleCtrRad, _ ByVal StartEndFg As Boolean) As Reference Dim Cnt(2) As Variant Call Fact.GSMGetObjectFromReference(Crl.Center).GetCoordinates(Cnt) Dim R As Double R = Crl.Radius.Value Dim Pos(2) As Variant 'Double Dim Direct As HybridShapeDirection Set Direct = Crl.FirstDirection Pos(0) = Direct.GetXVal Pos(1) = Direct.GetYVal Pos(2) = Direct.GetZVal Dim i As Long For i = 0 To UBound(Pos) Pos(i) = (Pos(i) * R * IIf(StartEndFg, 1, -1)) + Cnt(i) Next Set CreateEndPntRef = CreatePntRef(Pt, Fact, Pos) End Function '円弧 Private Function CreateCrl( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal PntRef As Reference, _ ByVal PlnRef As Reference, _ ByVal Ang As Double, _ ByVal Leng As Double) As HybridShapeCircleCtrRad Dim PAI As Double: PAI = 4 * Atn(1) Dim R As Double: R = Tan((Ang * 0.5) * PAI / 180) * Leng Dim Crl As HybridShapeCircleCtrRad Set Crl = Fact.AddNewCircleCtrRadWithAngles(PntRef, PlnRef, False, R, 0#, 180#) Call Pt.UpdateObject(Crl) Set CreateCrl = Crl End Function '平面 Private Function CreatePlnRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal CrvRef As Reference, _ ByVal PntRef As Reference) As Reference Dim Pln As HybridShapePlaneNormal Set Pln = Fact.AddNewPlaneNormal(CrvRef, PntRef) Call Pt.UpdateObject(Pln) Set CreatePlnRef = Pt.CreateReferenceFromObject(Pln) End Function '点-線上 Private Function CreatePntOnCrvRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal CrvRef As Reference, _ ByVal Leng As Double, _ ByVal Rev As Boolean) As Reference Dim Pnt As HybridShapePointOnCurve Set Pnt = Fact.AddNewPointOnCurveFromDistance(CrvRef, Leng, Rev) Pnt.DistanceType = 1 Call Pt.UpdateObject(Pnt) Set CreatePntOnCrvRef = Pt.CreateReferenceFromObject(Pnt) End Function 'データム化 Private Function ToDatum( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal Ref As Reference) As HybridShapeLineExplicit Dim Dtm As HybridShapeLineExplicit Set Dtm = Fact.AddNewLineDatum(Ref) Call Pt.UpdateObject(Dtm) Set ToDatum = Dtm End Function '点 Private Function CreatePntRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal Ary As Variant) As Reference Dim Pnt As HybridShapePointCoord Set Pnt = Fact.AddNewPointCoord(Ary(0), Ary(1), Ary(2)) Call Pt.UpdateObject(Pnt) Set CreatePntRef = Pt.CreateReferenceFromObject(Pnt) End Function '法線 Private Function CreateNormalRef( _ ByVal Pt As Part, _ ByVal Fact As HybridShapeFactory, _ ByVal SurfRef As Reference, _ ByVal PntRef As Reference, _ ByVal Lng As Double, _ ByVal Rev As Boolean) As Reference Dim Lin As HybridShapeLineNormal Set Lin = Fact.AddNewLineNormal(SurfRef, PntRef, 0#, Lng, Rev) Call Pt.UpdateObject(Lin) Call Pt.Update Set CreateNormalRef = Pt.CreateReferenceFromObject(Lin) End Function
矢印のサイズは調節しやすいように、先頭付近の定数にしています。
それぞれの意味はこちらの画像の状態です。
実行時、矢印の向きが意図しない方向に出来上がる可能性がある為
一度作成後、確認用のダイアログが出現します。
反転する必要がある場合は "はい" を選択してください。
御質問頂いたsauvignon1962さんは、「選択した面の中心に・・」
と書かれていますが "中心" を定義するのが難しいです。
この "中心" を仮に "重心" と捉えた場合、下記の画像の様に
中央部分が抜けた面を指定した場合、
中央部の点部分に矢印を作成する事になります。
当然、意図した位置では無い為、混乱を招く恐れがあるかと思います。
その為、前回のサンプル同様にクリックした面上の位置に矢印を作成
するようにしています。
(クリック出来る以上、確実に目的の面が存在しているはずです)
実行した際は、このような感じになります。
注記については、これから調べます。
・・・これらの動画はAutodeskのScreencastを利用しているのですが、
CATIAの動画ばかりUpしてて大丈夫なのかな?
(ごっそり削除されちゃうかな?)