C#ATIA

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

クリックした面に3Dな矢印を作る

タイトルが異なりますが、こちらの続きです。
クリックした面に法線を作成する - 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

矢印のサイズは調節しやすいように、先頭付近の定数にしています。
それぞれの意味はこちらの画像の状態です。

f:id:kandennti:20170606145028p:plain
実行時、矢印の向きが意図しない方向に出来上がる可能性がある為
一度作成後、確認用のダイアログが出現します。
f:id:kandennti:20170606145039p:plain
反転する必要がある場合は "はい" を選択してください。


御質問頂いたsauvignon1962さんは、「選択した面の中心に・・」
と書かれていますが "中心" を定義するのが難しいです。
この "中心" を仮に "重心" と捉えた場合、下記の画像の様に
中央部分が抜けた面を指定した場合、
f:id:kandennti:20170606145049p:plain
中央部の点部分に矢印を作成する事になります。
当然、意図した位置では無い為、混乱を招く恐れがあるかと思います。

その為、前回のサンプル同様にクリックした面上の位置に矢印を作成
するようにしています。
(クリック出来る以上、確実に目的の面が存在しているはずです)


実行した際は、このような感じになります。

注記については、これから調べます。
・・・これらの動画はAutodeskのScreencastを利用しているのですが、
CATIAの動画ばかりUpしてて大丈夫なのかな?
(ごっそり削除されちゃうかな?)