C#ATIA

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

図面のスケッチ

Fusion360の図面は、あまりやったことの無いのです。
解決済み: Re: 2D図面での矢視図 - Autodesk Community

斜めな矢視図ダメなんだ。不便すぎる。


あちらで行った図面でも十分なんですが、古き良き手書き図面の場合は、
位置関係が明確になる様に、平面図の軸線と矢視図の中心線を繋ぐ、
補助線的なものを書いたりされているものもあるんですよね。
f:id:kandennti:20210727162052p:plain
・・・恐らくドラフター経験者な方の図面と思われます。


これをCAD図面で入れるべきなものかどうかは、大いなる疑問なの
ですが、恐らく多くの3DCADの2D機能では難しいと思います。

でも、Fusion360だと意外なほど簡単に出来ましたよ、図面のスケッチ機能で。
初めて "役に立つかも" と感じました。


”導入前・導入直後、大きな期待をされながら、それ程でもなかった機能” ランキング
があったら、間違いなく1位は "図面のスケッチ機能" ですよ。(個人の感想です)

表題欄の細々した項目をパラメータで変更する3

こちらの続きです。
表題欄の細々した項目をパラメータで変更する2 - C#ATIA

表題欄用のパラメータが必要なのですが、DrawのパラメータってPartと違って
コピペ出来ないのですね。知りませんでした。

こんな感じのものを作りたいんですよ。
f:id:kandennti:20210727085608p:plain

毎回作るのは面倒な為、マクロで作っちゃいます。

'vba
Option Explicit

'作成用のパラメーター名
Private Const ALLKEYS = "date,custamer,partname,partnumber,drawnumber,material"

Sub CATMain()

    'ドキュメントのチェック をしたかったらKCL使ってね
'    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'ドキュメント
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    'キーワード
    Dim keys As Variant
    keys = Split(ALLKEYS, ",")

    'パラメータ
    Dim prms As Parameters
    Set prms = dDoc.Parameters.RootParameterSet.AllParameters
    
    'パラメータ作成-値は空
    Dim i As Long
    Dim prm As Parameter
    For i = 0 To UBound(keys)
        If Not isExists(prms, keys(i)) Then
            Set prm = prms.CreateString(CStr(keys(i)), "")
            prm.Rename CStr(keys(i))
        End If
    Next
    
End Sub

'パラメータの有無
Private Function isExists( _
    ByVal prms As Parameters, _
    ByVal name As String) _
    As Boolean

    isExists = True

    Dim prm As Parameter
    
    On Error Resume Next
        Set prm = prms.Item(name)
    On Error GoTo 0

    If prm Is Nothing Then
        isExists = False
    End If

End Function

定数 "ALLKEYS” の中の名前のパラメータを作っています。
今後、追加も削除もここ一行の修正で良いので楽です。
・・・これをsplitして配列作る方法は、海外の何処かで見かけて
感心しました。pythonじゃこんな事しないけど、VBAエディタの
貧弱さから考えると、この方法が一番楽な気がしてます。

パラメータを作成した直後にリネームしているのですが、
素のままだと、表示上は ”date” でも内部的に "drawing.date" に
なってしまい都合悪かったので。(設定の影響かも知れません)

空白のテキストを作る

CATIAのDrawで空白のテキストを作りたいんです。
全くわがまま人間(僕)は困っちゃいますね。


まず、テキストを作ってみます。
f:id:kandennti:20210726133020p:plain
文字は何でも良いです。

テキストの編集に入って、文字を削除します。
f:id:kandennti:20210726133207p:plain

OK押すと・・・
f:id:kandennti:20210726133020p:plain
戻っちゃいます。僕よりわがままですね。
これ、文字を削除した上にスペース文字を入れても
戻っちゃうんです。かなり頑固です。

要は、今後使うかもしれないんで空のテキストだけ
作っちゃいたいんです。
でも許してくれないんです。



諦めていたのですが、見つけましたよ。
まず、文字列タイプのパラメータを作成します。
f:id:kandennti:20210726133929p:plain

目的のテキストに、先程のパラメータを属性リンクさせちゃいます。
f:id:kandennti:20210726134120p:plain

パラメータを編集して、文字を削除しOKすると
f:id:kandennti:20210726134328p:plain

あ、やばい消えた と思ったのですが、
f:id:kandennti:20210726134534p:plain

選択してみると、ちゃんと存在してくれています。
f:id:kandennti:20210726134634p:plain
1文字分ぐらいの幅があります。そういえば属性リンク付けると
1文字分ちょっと多い感じしますね、いつも。

試しにパラメータに文字を入れると、ちゃんと復活します。
f:id:kandennti:20210726135313p:plain


あぁサポートさんに問い合わせたのですが、自己解決しました。
ごめんね。

表題欄の細々した項目をパラメータで変更する2

こちらの続きです。
表題欄の細々した項目をパラメータで変更する1 - C#ATIA

前回の最後に "ディテールシートにテーブル作り~" と書きました。
パラメータじゃなくて、テーブルを利用して を試すために
こんなマクロを作りました。

'vba
Option Explicit

Sub CATMain()
    
    'ドキュメント
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim infoTable As DrawingTable
    Set infoTable = getInfotable(dDoc)
    
    Dim txt As DrawingText
    Set txt = infoTable.GetCellObject(2, 3)
    
    Dim prms As Parameters
    Set prms = dDoc.Parameters
    
    Dim subPrms As Parameters
    Set subPrms = prms.SubList(txt, False)
    
    Dim prmStr As String
    prmStr = subPrms.GetNameToUseInRelation(txt)
    

    'テキストコレクション
    Dim txts As DrawingTexts
    Set txts = getBackViewTexts(dDoc)
    If txts.Count < 1 Then
        MsgBox "背景図に文字がありませんでした"
        Exit Sub
    End If
    
    
    Dim txt2 As DrawingText
    For Each txt2 In txts
        If txt2.name = "date" Then
            Exit For
        End If
    Next
    
    '属性適用
    Call txt2.InsertVariable(0, 0, subPrms.Item(1))
    Stop

End Sub

Private Function getInfotable( _
    ByVal dDoc As DrawingDocument) _
    As DrawingTable
    
    Set getInfotable = Nothing
    
    Dim st As DrawingSheet
    Set st = dDoc.sheets.Item("インフォメーション")
    
    Dim vi As DrawingView
    Set vi = st.views.Item(1)
    
    Dim tbl As DrawingTable
    For Each tbl In vi.Tables
        If tbl.name = "インフォメーション" Then
            Set getInfotable = tbl
            Exit Function
        End If
    Next
    
End Function

気力なくコメントも入っていないのは、出来なかったからです。

テーブルのセルは、属性リンクを付けて結果を表示させることは出来るのですが、
属性リンクの参照元になる事が出来ないのでは無いかと思っています。
GUIでも出来ないし。 違うかな? 方法あるのかな?
(Drawのテキストを参照するテキストは、GUIでも作れ無さそう)

接続された複数のスケッチ線を単一のスプラインにする

APIフォーラムのこちらに取り組んだのですが、完敗です。
Solved: Convert multiple lines into a single spline - Autodesk Community

NurbsCurve3Dオブジェクトにmergeメソッドが存在していたことを
完全に見落としていました。
Fusion 360 Help

但し、選択方法は僕の方が便利そうなので、Ekins氏のコードを一部修正し
2個1にしてみました。

# Fusion360API Python script
import adsk.core, adsk.fusion, traceback

def run(context):
    ui = adsk.core.UserInterface.cast(None)
    try:
        app :adsk.fusion.Application = adsk.core.Application.get()
        ui = app.userInterface

        # select sketch curve
        msg :str = 'Select'
        selFiltter :str = 'SketchCurves'
        sel :adsk.core.Selection = selectEnt(msg ,selFiltter)
        if not sel: return

        # get sketch curve
        sktCrv :adsk.fusion.SketchEntity = sel.entity
        refSkt: adsk.fusion.Sketch = sktCrv.parentSketch

        # get path
        comp: adsk.fusion.Component = refSkt.parentComponent
        path: adsk.fusion.Path = comp.features.createPath(sktCrv)

        # get Sketch Curves
        pathEnt: adsk.fusion.PathEntity
        sketchCurves = [pathEnt.entity for pathEnt in path]

        # get Single Spline
        crv: adsk.core.NurbsCurve3D = getSingleSpline(sketchCurves)

        # create curve
        skt: adsk.fusion.Sketch = comp.sketches.add(comp.xYConstructionPlane)
        skt.arePointsShown = False # hide sketch points
        skt.isComputeDeferred = True
        skt.sketchCurves.sketchFixedSplines.addByNurbsCurve(crv)
        skt.isComputeDeferred = False

        ui.messageBox('Done')

    except:
        if ui:
            ui.messageBox('Failed:\n{}'.format(traceback.format_exc()))

def getSingleSpline(
    sketchCurves: list) -> adsk.core.NurbsCurve3D:

    ui = None
    try:
        app: adsk.core.Application = adsk.core.Application.get()
        ui  = app.userInterface

        curves = []
        sketchCurve: adsk.fusion.SketchCurve
        for sketchCurve in sketchCurves:
            nurbs: adsk.core.NurbsCurve3D
            if sketchCurve.geometry.objectType == adsk.core.NurbsCurve3D.classType():
                nurbs = sketchCurve.worldGeometry
            else:
                nurbs = sketchCurve.worldGeometry.asNurbsCurve

            if len(curves) == 1:
                firstCurve: adsk.core.NurbsCurve3D = curves[0]
                newCurve: adsk.core.NurbsCurve3D = nurbs

                firstStart: adsk.core.Point3D = firstCurve.controlPoints[0]

                newStart: adsk.core.Point3D = newCurve.controlPoints[0]
                newEnd: adsk.core.Point3D = newCurve.controlPoints[len(newCurve.controlPoints) - 1]
                
                if firstStart.isEqualTo(newStart) or firstStart.isEqualTo(newEnd):
                    curves[0] = reverseNurbsCurve(curves[0])

            if len(curves) > 0:
                previousCurve: adsk.core.NurbsCurve3D = curves[len(curves) - 1]
                newCurve: adsk.core.NurbsCurve3D = nurbs

                existingEnd: adsk.core.Point3D = previousCurve.controlPoints[len(previousCurve.controlPoints) - 1]
                newStart: adsk.core.Point3D = newCurve.controlPoints[0]

                if not existingEnd.isEqualTo(newStart):
                    nurbs = reverseNurbsCurve(nurbs)

            curves.append(nurbs)

        bigCurve: adsk.core.NurbsCurve3D = None
        nurb: adsk.core.NurbsCurve3D
        for nurb in curves:
            if bigCurve is None:
                bigCurve = nurb
            else:
                bigCurve = bigCurve.merge(nurb)

        return bigCurve
    except:
        if ui:
            ui.messageBox('Failed:\n{}'.format(traceback.format_exc()))

def reverseNurbsCurve(
    curve: adsk.core.NurbsCurve3D) -> adsk.core.NurbsCurve3D:

    (_, points, degree, knots, isRational, weights, isPeriodic) = curve.getData()
    points = points[::-1]
    weights = weights[::-1]

    if isRational:
        return adsk.core.NurbsCurve3D.createRational(points, degree, knots, weights, isPeriodic)
    else:
        return adsk.core.NurbsCurve3D.createNonRational(points, degree, knots, isPeriodic)

def selectEnt(
    msg :str, 
    filtterStr :str) -> adsk.core.Selection :

    try:
        app = adsk.core.Application.get()
        ui = app.userInterface
        sel = ui.selectEntity(msg, filtterStr)
        return sel
    except:
        return None

正直、"複数のスケッチ線を単一のスプラインにするのは無理" と
示すために取り組んだのですが、結果的に出来る事が分かりました。
これ、需要があると思う。

表題欄の細々した項目をパラメータで変更する1

CATIAの図面枠って、通常は背景図で作ってますよね?
僕もそうなんですけど。

図面枠だけじゃなくて表題欄も背景図に入ってますよね?
最初からCATIAで図面を書いていたのであれば、表題欄はテーブルで
上手に作るのが正攻法のような気がするのですが、
他の2DCADから移行したので、極端にレイアウトを変更する訳には
行かなかったりするわけです。

結果的に、以前の2DCADから図面枠をDXFでエクスポートして
CATIAにインポートしてゴニョゴニョして作ってしまう企業様も
多いはずです。 ・・・よね?
f:id:kandennti:20210723140128p:plain
僕のはこんな感じです。記載すべき内容はそれぞれの枠に見立てた
線と線の間にテキストを配置して、そこに書き込みます。
(テーブルだと各セルに書きますが、DXFからインポートして作っているので
 セルじゃなくテキストなんです って事です。)

ちょっとした操作ミスで書き換える事が出来ないから、背景図にしている
のだろうと思うのですが、書き換える必要がある時は結構手間じゃないで
しょうか? ・・・要は ”頻繁じゃないけど面倒” なんです。

そこで、パラメータと連動して表題欄が書き換わったら素敵なんじゃないかな?
って思い付いたんです。
f:id:kandennti:20210723141604p:plain
そこで、マクロを作りました。

'vba Draw_TableTitleAttrLink Ver0.0.1 by Kantoku
Option Explicit

Sub CATMain()

    'ドキュメントのチェック をしたかったらKCL使ってね
'    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'ドキュメント
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    'パラメータ
    Dim prms As Parameters
    Set prms = dDoc.Parameters.RootParameterSet.AllParameters
    If prms.Count < 1 Then
        MsgBox "パラメータがありませんでした"
        Exit Sub
    End If
    
    'テキストコレクション
    Dim txts As DrawingTexts
    Set txts = getBackViewTexts(dDoc)
    If txts.Count < 1 Then
        MsgBox "背景図に文字がありませんでした"
        Exit Sub
    End If
    
    'ペア
    Dim txt_prm_Lst As Collection
    Set txt_prm_Lst = findPair(txts, prms)
    If txt_prm_Lst.Count < 1 Then
        MsgBox "パラメータと同一名の文字がありませんでした"
        Exit Sub
    End If
    
    '問い合わせ
    If Not query(txt_prm_Lst) Then
        Exit Sub
    End If
    
    '属性適用
    Call setParameter(txt_prm_Lst)

End Sub

'属性適用
'prm:txt_prm_Lst(collection:DrawingText,Parameter)
Private Sub setParameter( _
    ByVal txt_prm_Lst As Collection)

    Dim pair As Collection
    Dim txt As DrawingText
    Dim prm As Parameter
    For Each pair In txt_prm_Lst
        Set txt = pair.Item(1)
        Set prm = pair.Item(2)
        
        txt.Text = vbNullString
        Call txt.InsertVariable(0, 0, prm)
    Next

End Sub

'問い合わせ
Private Function query( _
    ByVal txt_prm_Lst As Collection) _
    As Boolean

    query = False
    
    Dim names As String
    names = getNames(txt_prm_Lst)
    
    Dim msg As String
    msg = txt_prm_Lst.Count & "個のパラメータを適用出来ます。" & vbCrLf & _
        "実行しますか?" & vbCrLf & vbCrLf
    
    If MsgBox(msg & names, vbYesNo + vbQuestion, "属性適用") = vbYes Then
        query = True
    End If
    
End Function

'テキスト名取得
Private Function getNames( _
    ByVal txt_prm_Lst As Collection) _
    As String

    Dim ary() As String
    ReDim ary(txt_prm_Lst.Count - 1)

    Dim i As Long
    Dim txt As DrawingText
    For i = 1 To txt_prm_Lst.Count
        Set txt = txt_prm_Lst.Item(i).Item(1)
        ary(i - 1) = txt.name
    Next
    
    getNames = Join(ary, vbCrLf)
    
End Function
    

'パラメータ名を元に同一名のテキストとのペアリスト取得
Private Function findPair( _
    ByVal txts As DrawingTexts, _
    ByVal prms As Parameters) _
    As Collection

    Dim lst As Collection
    Set lst = New Collection

    Dim prm As Parameter
    Dim txt As DrawingText
    Dim txt_prm As Collection
    
    For Each prm In prms
        Set txt = getTxtByName(txts, prm.name)
        If Not txt Is Nothing Then
            Set txt_prm = New Collection
            txt_prm.Add txt
            txt_prm.Add prm
            lst.Add txt_prm
        End If
    Next
    
    Set findPair = lst
    
End Function

'指定名のテキスト取得
Private Function getTxtByName( _
    ByVal txts As DrawingTexts, _
    ByVal name As String) _
    As DrawingText
    
    Set getTxtByName = Nothing

    Dim txt As DrawingText

    For Each txt In txts
        If txt.name = name Then
            Set getTxtByName = txt
            Exit For
        End If
    Next
    
End Function

'背景図のテキストコレクション取得
Private Function getBackViewTexts( _
    ByVal doc As DrawingDocument) _
    As DrawingTexts
    
    Dim backView As DrawingView
    Set backView = doc.sheets.ActiveSheet.views.Item(2)

    Set getBackViewTexts = backView.Texts

End Function

このマクロを実行すると、
f:id:kandennti:20210723142559p:plain
パラメータ名と同じフューチャー名のテキストを背面図から探し出して、
見付かったらパラメータとの属性リンクを作ります。
これで連動します。楽。
・背面図に入って、出ての操作が無くなる
・パラメータの変更はダブルクリックが必要だけど、簡単すぎなくて良い
・ "もう絶対にこの項目は変更しない!" と思った場合、パラメータを削除する
 だけで連動しなくなる(書き変わらなくなる)
・図面サイズを変更する際、図面枠を変更しても表題欄を保てる
・2枚組以上の図面を1ファイルで管理している場合、パラメータ1か所の
 変更で全て行える(個人的には4枚組とかある)
・外部ファイル等(ExcelCsvJson)で行わないのでCATDrawingファイル
 のみの管理で完結する
と思っていたのですが、ディテールシートにテーブル作り、そこと
連動する属性リンクを作った方が、ダブルクリックの手間が省けて
良いような気もしてきたな・・・。


うちのブログの内容はクズばかりだけど、属性リンクについてだけは
他にも殆ど情報が無いので充実しているかも。(検索するとソコソコHit)

ユーザーパターン2

こちらの続きです。
ユーザーパターン1 - C#ATIA

イベントに苦しんでます。

Custom Featuresの場合、形状と作り出す工程が3種類あるんです。
・コマンドパネルを押してコマンドを呼び出した時。(タイムラインが出来る時)
・タイムラインをクリックして編集する時。
・Custom Featureより手前のタイムラインが編集され、Custom Featureが
 再計算される必要がある時。

FusionBoxerの場合、全てこちらのon_computeメソッドが呼び出されています。
FusionBoxer/OffsetBoundingBoxCommand.py at master · tapnair/FusionBoxer · GitHub
こちらメソッドなのですが、apperでラッパーとして作成されている
Custom FeatureのcustomFeatureComputeイベントなんです。
Fusion 360 Help
apper/Fusion360CustomFeatureBase.py at master · tapnair/apper · GitHub

何故、呼び出されないの?