読者です 読者をやめる 読者になる 読者になる

C#ATIA

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

クリックした面に法線を作成する

こちらでコメント頂いたのですが、時間がナカナカ確保できずに
サンプルを作れませんでした。

3Dの文字モデリングマクロ8 - C#ATIA

正直な所、完成した状態がイメージし切れていないため、クリックした
面のクリックした位置に法線を作成するマクロを作成してみました。

'vba sample_CreateLineNormal_ver0.01  using-'ver0.0.10'
'クリックした面に法線を作成

Option Explicit

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 LinRef As Reference
    Set LinRef = CreateNormalRef(Pt, Fact, SurfRef, PntRef, 10#)
    Call DelList.Add(LinRef)
    
    'データム化
    Dim Dtm As HybridShapeLineExplicit
    Set Dtm = ToDatum(Pt, Fact, LinRef)
    
    '形状セット作成
    Dim HBdy As HybridBody
    Set HBdy = Pt.HybridBodies.Add()
    Call HBdy.AppendHybridShape(Dtm)
    
    'お掃除
    Dim Ref As Reference
    For Each Ref In DelList
        Call Fact.DeleteObjectForDatum(Ref)
    Next
    
    MsgBox "Done"
End Sub

'データム化
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)
    
    Dim Ref As Reference
    Set Ref = Pt.CreateReferenceFromObject(Pnt)
    
    Set CreatePntRef = Ref
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) As Reference
    Dim Lin As HybridShapeLineNormal
    Set Lin = Fact.AddNewLineNormal(SurfRef, PntRef, 0#, Lng, False)
    Call Pt.UpdateObject(Lin)
    
    Dim Ref As Reference
    Set Ref = Pt.CreateReferenceFromObject(Lin)
    
    Set CreateNormalRef = Ref
End Function

ProductとPartで動くようにしたつもりですが、Productは未テストです。

念の為、法線は面の表方向に作成されます。
もし意図していない方向に作成される場合は、面の向き自体が逆になっている
はずです。

Fusion360やSpace-e等、比較的3DCADでは面の表裏を色を変えて表示したり
することで、視覚的にわかるようになっているものなのですが、CATIA V5は
ダメなんですよね・・・ 視覚的にわからないです。
OpenGLは表裏で2回描写するのだから、それ程難しくないと思うのですが)

接合等、複数の面をオフセットする際の "正" の方向は、接合された面の最初の
面の向きに依存しているように感じます。

Parasolidのエラー

客先からメールで支給してもらった複数のParasolidファイルうち1個だけが
変換できずにエラー。

Fusion360 , Space-e , 3DTascalX , A360Viewer 全てでNGだったので
ファイルが壊れていると確信。

再度客先より支給してもらうと、今度はOKでした。


ファイルを比較してみると、小数点の後ろに1つだけスペース文字が入っている
部分が2ヶ所。 原因はこれだけだったようです。

f:id:kandennti:20170511173234p:plain

ファイルが途中で途切れてしまう、と言う経験はあったのですが
余計なスペース文字が入る事なんてメールであるものなのかな?

今後、ダメだった場合の覚書です・・・。

Cube in a Cube 1(予告)

先日のジュラコンの切削条件を探していた際に見つけたこちらの動画

キューブ内のキューブ - YouTube

驚きました、旋盤でこれを作るとは・・・。探してみるとこちらは
工具、治具を作るところから、最後はそれらの寸法まで

Cube in a cube / Turners cube - YouTube

しかも、四個もブロックが。


この形状、旋盤の独占なものとは思えなかったので探してみると
マシニングの動画も有りましたが

CNC Cube inside a Cube - YouTube

アンダーカット部分は未加工っぽい。

こちらを見てみると、アンダーカット部分も加工しています。

A Cube in a Cube in A cube, CNC Milling - YouTube

ヘリカル加工後、切削スピードが上がったので Adaptive Clearing な
加工しているのかと思ったら、12倍速だったんですね。
EdgeCamには、恐らく機能が無いのかな?
但し、最後の一面をどの様に加工したのかは動画に出てません。


よし、工具(Tスロット)があったら加工してみよう! と、探したら
数年前に他の人間が購入しちょっとだけ使ったものが、見つかりました。

とりあえず、手持ちの工具で加工できそうな形でモデリングして見ました。
f:id:kandennti:20170510194421p:plain
・・・ "手持ちの工具" と言うのが、ナカナカ苦しく手間取りました。

後は最後の一面を加工する際の作戦なのですが、先人の知恵の
グルーガン作戦は無視することにします。

ここで公言しておけば、後戻りは出来ないので書いておきました。
(失敗したら、無かった事にしておこう・・・)

ゴールネットのフック

こちらの続きです。

Fusion360CAM ポスト処理(オマケ) - C#ATIA

案の定、数が激減したため、重い腰をやっと上げて再度作成しました。
数が減る最大の原因は、ネットからフック部分が外れて紛失しているようで
割れてしまっているわけでは無さそうです。

前回は既製品を真似て削りだしましたが、紛失原因を良く考えてみると
画像の赤印部がR面になっていることの様に感じます。
(まるでゴールネットが外れるようにガイドしているような感じ)
f:id:kandennti:20170509181106p:plain

その為、加工が面倒にならない範囲で返しを設置してみました。
f:id:kandennti:20170509181113p:plain

特に根拠なく設置した為、寸法不足です。
f:id:kandennti:20170509181058p:plain

前回は Fusion360 + Space-e でNCデータを作りましたが、今回は
Vortex練習を兼ねてPowerMillで。

f:id:kandennti:20170509181051p:plain

ジュラコンの切削条件がイマイチわからない上、Vortexは更にわからない・・・。
加工終わってからYoutube探したら、こちらを発見。

POM Milling for HSM toolpass - YouTube

Φ6かな? F4000前後でS11000・・・ もうちょっと上げれたんだな。
(当方F3000

マダマダ勉強不足だな。

サーフェスの色をボディに反映する2

こちらの続きですが、タイトル名がふさわしくないです。

サーフェスの色をボディに反映する - C#ATIA

takashiさんからコメントを頂き、早速ご要望を反映してみました。

'vba sample_ApplyColor_ver0.0.2  using-'KCL0.0.10'
'指定した形状セット(ボディ)の面の色をボディ(形状セット)に(大体)反映する
Option Explicit

'*** 設定値 ***
Const CogTolerance = 0.01  '同一判断重心距離
Const AreaTolerance = 0.01 '同一判断面積
'**************

Const CogTolSqr = CogTolerance * CogTolerance

Sub CATMain()
    'ドキュメントのチェック
    Dim Doc As Document: Set Doc = CATIA.ActiveDocument
    If Not (IsType_Of_T(Doc, "PartDocument") Or _
            IsType_Of_T(Doc, "ProductDocument")) Then
        MsgBox "Part か Product でしか利用できません!"
        Exit Sub
    End If
    
    '形状セット選択
    Dim Msg$: Msg = "色の参照元となる形状セット(ボディ)を選択して下さい : ESCキー 終了"
    Dim HB As AnyObject
    Set HB = KCL.SelectItem(Msg, Array("HybridBody", "Body"))
    If KCL.IsNothing(HB) Then Exit Sub
    Dim HBRefs As Variant: HBRefs = GetTopoFacesRef(HB)
    If IsEmpty(HBRefs) Then Exit Sub
    
    'ボディ選択
    Msg = "色を反映するボディ(形状セット)を選択して下さい : ESCキー 終了"
    Dim Bdy As AnyObject
    Set Bdy = KCL.SelectItem(Msg, Array("HybridBody", "Body"))
    If KCL.IsNothing(Bdy) Then Exit Sub
    Dim BdyRefs As Variant: BdyRefs = GetTopoFacesRef(Bdy)
    If IsEmpty(BdyRefs) Then Exit Sub
    
    '確認
    Msg = HB.Name + "(" + CStr(UBound(HBRefs) + 1) + "枚)の色を" + vbNewLine + _
          Bdy.Name + "(" + CStr(UBound(BdyRefs) + 1) + "枚)に" + vbNewLine + _
          "反映しますか?"
    If MsgBox(Msg, vbYesNo) = vbNo Then Exit Sub
    
    '形状セットトポロジ情報取得
    Dim HBGeos As Variant
    HBGeos = GetGeoInfo(HB, HBRefs)
    
    'ボディトポロジ情報取得
    Dim BdyGeos As Variant
    BdyGeos = GetGeoInfo(Bdy, BdyRefs)
    
    '形状セットカラー情報取得
    Dim HBColor As Variant
    HBColor = GetColor(HB, HBRefs)
    
    '重心・面積から反映色を決める
    Dim BdyColor As Variant
    BdyColor = DecideApplyColor(HBGeos, BdyGeos, HBColor)
    
    '色の反映
    Call SetColor(Bdy, BdyRefs, BdyColor)
    
    '終了
    Call OjUpdate(Bdy)
    MsgBox "反映終了"
End Sub

'更新
Private Sub OjUpdate(ByRef AnyOj As AnyObject)
    Dim Pt As Part: Set Pt = KCL.GetParent_Of_T(AnyOj, "PartDocument").Part
    Pt.UpdateObject AnyOj
End Sub

'重心・面積から反映色を決める
Private Function DecideApplyColor(ByRef HBGeos As Variant, _
                                  ByRef BdyGeos As Variant, _
                                  ByVal HBColors As Variant) As Variant
    Dim BdyColors() As Variant: ReDim BdyColors(UBound(BdyGeos))
    Dim i&, j&
    For i = 0 To UBound(BdyGeos)
        For j = 0 To UBound(HBGeos)
            If IsCogEqual(BdyGeos(i), HBGeos(j)) And _
               IsAreaEqual(BdyGeos(i), HBGeos(j)) Then
                BdyColors(i) = HBColors(j)
                Exit For
            End If
        Next
    Next
    DecideApplyColor = BdyColors
End Function

'COG一致
Private Function IsCogEqual(ByVal P1 As Variant, ByVal P2 As Variant) As Boolean
    IsCogEqual = False
    If Abs((P2(0) - P1(0)) * (P2(0) - P1(0)) + _
           (P2(1) - P1(1)) * (P2(1) - P1(1)) + _
           (P2(2) - P1(2)) * (P2(2) - P1(2))) < CogTolSqr Then
        IsCogEqual = True
    End If
End Function

'Area一致
Private Function IsAreaEqual(ByVal P1 As Variant, ByVal P2 As Variant) As Boolean
    IsAreaEqual = False
    If Abs(P2(3) - P1(3)) < AreaTolerance Then
        IsAreaEqual = True
    End If
End Function

'色情報反映
Private Sub SetColor(ByVal ParentOj As AnyObject, ByRef Refs As Variant, ByVal Colors As Variant)
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(ParentOj, "PartDocument")
    Dim Sel As Selection: Set Sel = Doc.Selection
    Dim VPS As VisPropertySet: Set VPS = Sel.VisProperties
    Dim i&
    
    CATIA.HSOSynchronized = False
    For i = 0 To UBound(Colors)
        If IsEmpty(Colors(i)) Then GoTo Continue
        With Sel
            .Clear
            .Add Refs(i)
        End With
        VPS.SetRealColor Colors(i)(0), Colors(i)(1), Colors(i)(2), 1
Continue:
    Next
    CATIA.HSOSynchronized = True
End Sub

'色情報の取得
Private Function GetColor(ByVal ParentOj As AnyObject, ByRef Refs As Variant) As Variant
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(ParentOj, "PartDocument")
    Dim Sel As Selection: Set Sel = Doc.Selection
    Dim VPS As VisPropertySet: Set VPS = Sel.VisProperties
    Dim i&, r&, g&, b&
    Dim Colors() As Variant: ReDim Colors(UBound(Refs))
    
    CATIA.HSOSynchronized = False
    For i = 0 To UBound(Refs)
        With Sel
            .Clear
            .Add Refs(i)
        End With
        VPS.GetRealColor r, g, b
        Colors(i) = Array(r, g, b)
    Next
    CATIA.HSOSynchronized = True
    
    GetColor = Colors
End Function

'CogとAreaの取得
Private Function GetGeoInfo(ByVal ParentOj As AnyObject, ByRef Refs As Variant) As Variant
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(ParentOj, "PartDocument")
    Dim SPA As SPAWorkbench: Set SPA = Doc.GetWorkbench("SPAWorkbench")
    Dim Infos() As Variant: ReDim Infos(UBound(Refs))
    Dim Cog(2) As Variant, i&, Mes As Variant 'Measurable
    
    For i = 0 To UBound(Infos)
        Set Mes = SPA.GetMeasurable(Refs(i))
        Mes.GetCOG Cog
        Infos(i) = KCL.JoinAry(Cog, Array(Mes.Area))
    Next
    
    GetGeoInfo = Infos
End Function

'topologyのFaceのReference取得
Private Function GetTopoFacesRef(ByVal AnyOj As AnyObject) As Variant
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(AnyOj, "PartDocument")
    Dim Sel As Selection: Set Sel = Doc.Selection
    
    CATIA.HSOSynchronized = False
    With Sel
        .Clear
        .Add AnyOj
        .Search "Topology.CGMFace,sel"
    End With
    If Sel.Count2 < 1 Then Exit Function
    
    Dim Pt As Part: Set Pt = Doc.Part
    Dim Refs() As Reference: ReDim Refs(Sel.Count2 - 1)
    Dim i&, Face As AnyObject
    For i = 0 To Sel.Count2 - 1
        Set Refs(i) = Sel.Item(i + 1).Reference
    Next
    CATIA.HSOSynchronized = True
    
    GetTopoFacesRef = Refs
End Function

CATMainのユーザーに選択してもらう部分をちょっと修正しただけです。
(その為、変数名がふさわしくない状態になっておりますが・・・)

サーフェス(形状セット) ⇔ ソリッド
サーフェス(形状セット) ⇔ サーフェス(形状セット)
ソリッド ⇔ ソリッド
間のカラー反映が出来るようになっております。
(時系列セットは未対応)


処理速度については、遅い原因がわかっています。
現状の処理では、お互いの面の枚数分総当りで一致するかどうかを
チェックしているのですが、これが非常に効率悪いです。
重心位置を元に、過去に取り組んだモートン順序の8分木空間分割を
利用する事で、組み合わせ数を大幅に減らせ処理速度が速くなるだろう
とは思っておりますが、それなりにパワーが必要でして・・・。

Autodesk Certified User

PowerMillは、常に蚊帳の外…

Certiport | Home - Certify to Succeed

PowerMill2018インストールして見ました

複数バージョンのインストールが出来たので、PowerMill2018をインストール
して見ました。
・・・バグっぽいものが随所に見られ、SP2ぐらいまでは使わない
と決めました。

特に痛いのが、こちらのコンテキストメニューからマクロの呼び出しが出来ない事。
2018 User menu bug - Autodesk Community


作業のやり難さを改善できたと思っていたのに、
これらが利用できません。

工具コンテキストメニューから工具変更 - C#ATIA

コンテキストメニューからフォルダを展開する - C#ATIA

他にも幾つか、この方法で呼び出すマクロがあるのですが・・・。

フォーラムにはバグって投稿されているのですが、メーカーさん的には
もっと先を見据えて、保留したのかな?
Fusion360やReMakeのコンテキストメニューのような、円形のものに
将来的にはなるんじゃないのかな?
f:id:kandennti:20170425152225p:plain