C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA(最近はPMillマクロとFusion360APIが多い)

Drawの2点間距離を求める

「Drawの二つの点の距離を求めたい」と御相談頂きました。

過去に必要になった場合は、座標値から計算して求めていたのですが、
確かに他の方法を調べた事が有りませんでした。


まず、元にするデータですがアクティブなビューに点を
二つだけ作っておきます。
f:id:kandennti:20190801182224p:plain
3Dとリンクしていない、純粋にDrawの点です。

〇パラメータと式
まず思い付いたのが、こちらのパラメータと式を使った方法です。
ボディ - ボディ の最短距離の測定1 - C#ATIA
これ、手動でも出来ませんでした・・・。

〇SPAWorkbench
続いて思い付くのが、SPAWorkbenchを利用した方法です。
ボディ - ボディ の最短距離の測定3 - C#ATIA
疑問が2つ。
・DrawingDocumentからSPAWorkbenchが取得出来るのか?
・Drawの要素でReferenceが取得出来るのか?

'vba Referenceから2点間距離
Sub CATMain()
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim vi As DrawingView
    Set vi = doc.Sheets.ActiveSheet.views.ActiveView
    
    Dim p1 As Point2D
    Set p1 = vi.GeometricElements.Item(2)
    
    Dim ref1 As Reference
    Set ref1 = GetReference(p1)
    
    Dim p2 As Point2D
    Set p2 = vi.GeometricElements.Item(3)
    
    Dim ref2 As Reference
    Set ref2 = GetReference(p2)
    
    leng = GetLength_Ref(ref1, ref2)
    
    MsgBox leng
End Sub

'リファレンスの取得
Private Function GetReference( _
    ByVal p As Point2D) _
    As Reference
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
        
    sel.Clear
    sel.Add p
    Set GetReference = sel.Item2(1).Reference
    sel.Clear
    
End Function

'2点間最短距離-SPAWorkbench
Private Function GetLength_Ref( _
    ByVal ref1 As Reference, _
    ByVal ref2 As Reference) _
    As Double
    
    GetLength_Ref = CATIA.ActiveDocument _
        .GetWorkbench("SPAWorkbench") _
        .GetMeasurable(ref1) _
        .GetMinimumDistance(ref2)
        
End Function

試した所OKです。
・DrawingDocumentからSPAWorkbenchが取得出来ます。
・Drawの要素はSelection経由でReferenceが取得出来ます。
Selection経由以外でReferenceを取得する方法あるのかな?


〇座標値から計算
最後に何時もやっている、点の座標値を取得して計算させる方法です。

'vba 座標値から計算で2点間距離
Sub CATMain()
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim vi As DrawingView
    Set vi = doc.Sheets.ActiveSheet.views.ActiveView
    
    Dim p1 As Point2D
    Set p1 = vi.GeometricElements.Item(2)
    
    Dim pos1 As Variant
    pos1 = GetPos(p1)
    
    Dim p2 As Point2D
    Set p2 = vi.GeometricElements.Item(3)
    
    Dim pos2 As Variant
    pos2 = GetPos(p2)
    
    leng = GetLength_Pos(pos1, pos2)
    
    MsgBox leng
End Sub

'座標値取得
Private Function GetPos( _
    ByVal p As Point2D) _
    As Variant
    
    Dim pv As Variant
    Set pv = p
    
    Dim pos(1) As Variant
    pv.GetCoordinates pos
    
    GetPos = pos
    
End Function

'2点間最短距離-座標値
Private Function GetLength_Pos( _
    ByVal pos1 As Variant, _
    ByVal pos2 As Variant) _
    As Double
    
    GetLength_Pos = Sqr( _
        (pos2(0) - pos1(0)) ^ 2 + _
        (pos2(1) - pos1(1)) ^ 2)
        
End Function

個人的には、座標値から計算するかなぁ。

Drawのスプラインを描く3

こちらの続きです。
Drawのスプラインを描く2 - C#ATIA

前回の記録を録ったマクロを、Drawで流用する事を考慮し修正します。

一番欲しいのはスプラインの作成部分ですが、コントロールポイントも必要と
なる事が前回わかりましたので、それも含めて関数化してしまいたいです。

つまり座標値配列をスプライン作成関数に突っ込むと、スプラインが出来上がる

と言う感じです。

'vba
Sub CATMain()
    
    Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
    
    Dim part1 As part
    Set part1 = partDocument1.part
    
    Dim bodies1 As Bodies
    Set bodies1 = part1.Bodies
    
    Dim body1 As Body
    Set body1 = bodies1.Item("パーツ ボディー")
    
    Dim sketches1 As Sketches
    Set sketches1 = body1.Sketches
    
    Dim sketch1 As Sketch
    Set sketch1 = sketches1.Item("スケッチ.1")
    
    Dim factory2D1 As Factory2D
    Set factory2D1 = sketch1.OpenEdition()
    
    Dim posLst As Variant
    posLst = Array( _
                Array(209.93692, -28.521069), _
                Array(98.861, 35.288517), _
                Array(11.024345, -32.459942) _
                )
    
    Dim spline2D1 As Spline2D
    Set spline2D1 = InitSpline2D(posLst, factory2D1)
    
    sketch1.CloseEdition
    
    part1.Update

    MsgBox "Done"
    
End Sub

'スプラインの作成
'param:posLst
''' @param:posLst-array(array(Double,Double),,,)
''' @param:fact-Factory2D
''' @return:Spline2D
Private Function InitSpline2D( _
    ByVal posLst As Variant, _
    ByVal fact As Factory2D) _
    As Spline2D
    
    'コントロールポイント用配列
    Dim ctls() As Variant
    ReDim ctls(UBound(posLst))
    
    'コントロールポイントを作りつつ配列に代入
    Dim i As Long
    Dim ctl As ControlPoint2D
    For i = 0 To UBound(posLst)
        pos = posLst(i)
        Set ctls(i) = fact.CreateControlPoint(pos(0), pos(1))
    Next
    
    'バリアントFactory2D
    Dim factVri As Variant
    Set factVri = fact
    
    'スプライン生成
    Set InitSpline2D = factVri.CreateSpline(ctls)
    
End Function

目的の為に、InitSpline2D関数を作りました。パラメータは
座標値配列とFactory2Dです。 Factory2Dさえ受け取ってしまえば
スケッチだろうがDrawだろうが関係無く使用出来る関数 と言うわけです。

実際に実行すると、記録を録ったマクロと同様のスケッチのスプラインが
出来上がることが確認出来ました。
f:id:kandennti:20190731141533p:plain


いよいよ本題です。
先程作った「InitSpline2D関数」はDrawでも流用出来るようにしています。
必要なのは座標値配列とFactory2Dです。Drawの場合、Factory2Dは
DrawingViewオブジェクトのプロパティとして持っています。
Drawのスプラインを描く1 - C#ATIA

その為、アクティブなビューにスプラインを描くようなマクロに修正してみました。

'vba
Sub CATMain()
    
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim vi As DrawingView
    Set vi = doc.Sheets.ActiveSheet.views.ActiveView
    
    Dim fact As Factory2D
    Set fact = vi.Factory2D
    
    Dim posLst As Variant
    posLst = Array( _
                Array(209.93692, -28.521069), _
                Array(98.861, 35.288517), _
                Array(11.024345, -32.459942) _
                )
    
    Dim sp As Spline2D
    Set sp = InitSpline2D(posLst, fact)

    MsgBox "Done"
    
End Sub

極端な話ですが、スケッチ時のFactory2Dが

    Dim factory2D1 As Factory2D
    Set factory2D1 = sketch1.OpenEdition()

Drawでは

    Dim fact As Factory2D
    Set fact = vi.Factory2D

に変わったようなものです。

実際に実行してみると、こんな感じです。
f:id:kandennti:20190731142832p:plain
もう怖くないでしょ?

Drawのスプラインを描く1

「マクロでDrawのスプラインを描きたい」と御相談頂きました。
実は、以前取り組んだことが有ります。図面の変更前と後で変更部分にスプラインで
目立つように印を付ける為です。(恐らく一部の関連企業だけだろうと思います)
先にお伝えしておくと、スプラインを「閉じる」はマクロで出来ませんでした・・・。


では、本題です。
敷居の高い原因は、Drawのマクロの記録が録れない事です。間違いなく録れません。
以前非常にお世話になった「Unofficial CATIA User Forum」でy4yamaさんが
非常に大きなヒントを記載していました。
Drawは記録が録れないが、Sketchは記録が録れる
と。もちろん、そのままでは利用出来ない為、修正する必要は有ります。


2Dの点や線を描く場合、Factory2Dオブジェクト経由となります。
r1 Factory2D (Object)

スケッチオブジェクトには、Factory2Dプロパティが存在しています。
r1 Sketch (Object)

Drawの場合はドローイングビューオブジェクトに点・線を描く事になるのですが、
ドローイングビューオブジェクトにも、Factory2Dプロパティが存在しています。
r1 DrawingView (Object)


細かな事は次回以降に書くつもりですが、極端な話スケッチでマクロの記録を録り、
Sketch → DrawingView
に書き換える事で流用出来ます。

サンプル探してHelpとにらめっとするより、記録を流用した方が遥かに楽ですよ。

’サーフェス上' に点を持つ面の面積の取得

久々にCATIAのマクロです。

こちらの問題に取り組んで見ました。
Point on face - accessing face from point - DASSAULT: CATIA products - Eng-Tips

質問者さんが記載していますが、「サーフェス上の点」には
どの面上に点を作ったかを示すSurfaceプロパティ(Reference)が有ります。
r1 HybridShapePointOnSurface (Object)

このリファレンスでMeasurableを利用して面積の取得を行いたいが
エラーになる との事。 確かになります。

幸い試した所、Surfaceプロパティのリファレンスでオフセットサーフェスが作成できた為、
一時的な面を作成し、その面の面積を取得する方法にして見ました。


CATIAのマクロの場合、とにかくReferenceが関係する場合は多いのですが、
ソリッドや接合した状態のReferenceの取得や利用は、なかなか難しいですね。

ビュー名のテキストを追加する

こちらで記載した事の確認です。
複数のビュー名とリンクした状態のテキストを新作 - C#ATIA

属性リンクを持ったテキストの作成は非常に面倒なのですが、
(しかも確認する手段が無い)単純にビュー名とリンクした状態の
テキストの作成であれば単純です。
日本語「図の名前を追加」
英語「Add View Name」
のコマンドをマクロで実行するだけです。

’vba
Option Explicit

Sub CATMain()

    'コマンド - 言語依存しているので適切なものを!
    Dim cmd As String
    'cmd = "図の名前を追加" '日本語
    cmd = "Add View Name" '英語
    
    'ビュー選択
    Dim msg As String
    msg = "ビュー名のテキストを追記するビューを選択してください / ESC-キャンセル"
    
    Dim filter As Variant
    filter = Array("DrawingView")
    
    Dim sel As Variant 'Section
    Set sel = CATIA.ActiveDocument.selection
    
    sel.Clear
    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Sub
    End Select

    Call CATIA.StartCommand(cmd)
    
End Sub

マクロ内で事前選択して、コマンド実行です。

こちらに記載したコマンドIDが判れば、言語依存が無くなるのですが
見つかりませんでした。
コマンドID - C#ATIA

複数のビュー名とリンクした状態のテキストを新作

恐らく、こちらの2つの目的を一体化したものがお望みだろうと
思われる質問を頂きました。
カレントビューの角度や生成スタイルの取得2 - C#ATIA
検索したテキストの文字を、指定したテキストに追記する - C#ATIA

言葉にすると・・・
「複数のビュー名とリンクした状態のテキストを新作したい」
と解釈しました。

f:id:kandennti:20190604192043p:plain
単に「こちらの青のテキストを削除しちゃって、復活させたい」と言う事では
無いですよね?
これであれば、マクロを使うまでも無く、こちらのコマンドで可能です。
f:id:kandennti:20190604192051p:plain
・・・マクロだと、StartCommandで出来るのかな?


さて本題ですが、DrawingTextって、困った事に "式" が利用できないですよね?
リンクした状態を作る為には、属性リンクを利用する以外方法を知らないです。
こちらの経験が生かせそうです。
2D属性リンクを扱いたい1 - C#ATIA

'vba
Sub CATMain()
    
    'ドキュメント
    Dim dwDoc As DrawingDocument
    Set dwDoc = CATIA.ActiveDocument
    
    'selection
    Dim sel As selection
    Set sel = dwDoc.selection
    
    '検索-紫の文字
    sel.Clear
    sel.Search "CATDrwSearch.DrwText.Color='(128,0,255)',all"
    
    If sel.Count2 < 1 Then
        MsgBox "該当する文字は見つかりませんでした"
        Exit Sub
    End If
    
    '検索でHitした文字のビュ-の取得
    Dim viLst As Collection
    Set viLst = New Collection
    
    Dim i As Long
    For i = 1 To sel.Count2
        viLst.Add sel.Item2(i).Value.Parent.Parent
    Next
    sel.Clear
    
    'ビュ-名のパラメータの取得
    '本当は重複削除チェックすべき
    Dim prmLst As Collection
    Set prmLst = New Collection
    
    Dim vi As DrawingView
    Dim subLst As Parameters
    Dim prm As Parameter
    For Each vi In viLst
        Set subLst = dwDoc.Parameters.SubList(vi, False)
        Set prm = GetParameter("Name", subLst)
        If Not prm Is Nothing Then
            prmLst.Add prm
        End If
    Next
    
    'アクティブビューに空のテキスト新作
    Dim actVi As DrawingView
    Set actVi = dwDoc.Sheets.ActiveSheet.views.ActiveView
    
    Dim txt As DrawingText
    Set txt = actVi.Texts.Add(String(prmLst.Count, vbLf), 0, 0)
    
    '属性リンクを追加
    For i = 1 To prmLst.Count
        txt.InsertVariable Len(txt.Text) - (prmLst.Count - i), 0, prmLst(i)
    Next

    '終わり
    MsgBox "Done"

End Sub

'パラメータ取得
Private Function GetParameter( _
    ByVal key As String, _
    ByVal params As Parameters) As Parameter
    
    Set GetParameter = Nothing
    
    Dim prm As Parameter
    Err.Number = 0
    On Error Resume Next
        Set prm = params.Item(key)
    On Error GoTo 0
    
    Set GetParameter = prm
End Function

こんな感じのデータを用意しました。
f:id:kandennti:20190604192124p:plain
上記のマクロを実行すると、紫のテキストを持つビュー名を取得し、
アクティブビューの原点付近にリンク付きのビュー名リストのテキストが出来上がります。
ややこしいのでこんな感じです。
f:id:kandennti:20190604192134p:plain

簡単に確認したところ、ID・Suffixの修正も反映されます。

正直な所、これ以上先は手動でしか出来そうに有りません。
(マクロで修正すると属性リンクが消えます)
DrawingViewに事前に改行を入れることで対応しましたが、ここが一番難しかった。
DrawingViewの改行はラインフィールド(vbLf)です。

検索したテキストの文字を、指定したテキストに追記する

御質問頂いた内容を正しく理解できているかわからないのですが、
「Drawで検索してHitしたテキストの文字を、他のテキストに追記したい」
と理解しました。

テストするものは、このような感じにしました。
f:id:kandennti:20190604125304p:plain

コードはこちら。

'vba
Sub CATMain()
    
    'ドキュメント
    Dim dwDoc As DrawingDocument
    Set dwDoc = CATIA.ActiveDocument
    
    'selection
    Dim sel As selection
    Set sel = dwDoc.selection
    
    '検索-紫の文字
    sel.Clear
    sel.Search "CATDrwSearch.DrwText.Color='(128,0,255)',all"
    
    If sel.Count2 < 1 Then
        MsgBox "該当する文字は見つかりませんでした"
        Exit Sub
    End If
    
    '文字取得
    Dim txts() As String
    ReDim txts(sel.Count2 - 1)
    
    Dim i As Long
    For i = 1 To sel.Count2
        txts(i - 1) = sel.Item2(i).Value.Text
    Next
    
    '挿入する文字選択
    Dim selVar As Variant
    Set selVar = sel
    
    Dim msg As String
    msg = "挿入するテキストを指定してください"
    
    Dim filter As Variant
    filter = Array("DrawingText")
    
    Select Case selVar.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Sub
    End Select
    
    Dim target As DrawingText
    Set target = selVar.Item2(1).Value
    
    '検索した文字をターゲットに追加-改行入れてます
    target.Text = target.Text & vbCrLf & Join(txts, vbCrLf)
    
    '終わり
    MsgBox "Done"

End Sub

ここから紫色の文字を検索で取得し、指定したテキストに取得した
文字を追記します。
仮に「バージョン 5 の終了」の文字を指定するとこんな感じになります。
f:id:kandennti:20190604125249p:plain