C#ATIA

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

CATIAな空のコレクションオブジェクトのForEach

CATIA V5です。
知らなかったのですが、表題のループはエラーになるんですね。

新規のDrawingSheetを作って(テキストが1個も無い状態)
DrawingTextsをForEachするとエラーになる と言うサンプルです。

'vba エラーになります

Option Explicit

Sub CATMain()

    '空のリストのFor Each
    Dim lst As Collection
    Set lst = New Collection

'    lst.Add "hoge"
'    lst.Remove 1
    
    Dim dmy As Variant
    For Each dmy In lst
        '空でも大丈夫
    Next


    '空のCATIAのコレクションのFor Each
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim texts As DrawingTexts
    Set texts = dDoc.sheets.ActiveSheet.views.Item(1).texts

    Dim text As DrawingText
    For Each text In texts
        '空だとエラー
    Next
    
End Sub

そうなんだ、countチェックするとかしなきゃならないのか。
VBAのコレクションは空でも大丈夫。pythonのリストも大丈夫。

・・・面倒だな。今まで試してなかったんだな。

"リンクの結果として"のソリッドを分離する

CATIA V5です。

"3Dの分離" の意味を間違えているかもしれないのですが、
表題のサンプルを作ってみました。

"リンクの結果として" でペーストされて出来たボディ内の
ソリッドのリンクを分離します。

探してみた所、仰っていたように "CATIA.StartCommand" を
使用するしか方法が無いようです。
又、言語依存の無いコマンドIDをこちらで探しましたが
見つけることが出来ませんでした。
(ひょっとしたら存在するかもしれませんが、今の所見つかりません)
Free CAD Designs, Files & 3D Models | The GrabCAD Community Library

予測通り、CATIAの設定言語を判断し、"CATIA.StartCommand" しか
方法が無さそうです。
言語の判断はこちらを利用しました。
お手軽に言語判定を行いたい - C#ATIA
※当時思い付きこれを作りましたが、後に海外の方も同様の方法で
 言語判断されているのを見たことがあります。

サンプルはこちらです。

'vba リンクの結果として のリンクを分離

Option Explicit

Sub CATMain()

    Dim partDoc As PartDocument
    Set partDoc = CATIA.ActiveDocument

    'ソリッドの検索
    Dim sel As Selection
    Set sel = partDoc.Selection

    sel.Search "CATPrtSearch.MechanicalFeature,all"
    If sel.Count2 < 1 Then
        MsgBox "対象要素がありません!"
        Exit Sub
    End If

    '外部リンク付きソリッドの取得
    Dim targetFeatures As Collection
    Set targetFeatures = New Collection
    
    Dim feature As Solid
    
    Dim i As Long
    For i = 1 To sel.Count2
        Set feature = sel.Item(i).Value
        
        If has_sourceElement(feature) Then
            targetFeatures.Add feature
        End If
    Next

    If targetFeatures.count < 1 Then
        MsgBox "対象要素がありません!"
        Exit Sub
    End If

    '言語からコマンドID取得
    Dim lang As String
    lang = GetLanguage()
    
    Dim cmd As String
    
    Select Case lang
        Case "ja"
            cmd = "分離"
        Case "en"
            cmd = "Isolate"
        Case Else
            MsgBox "CATIAの言語が判断出来ない為中止します"
            Exit Sub
    End Select

    '分離コマンド実行
    For Each feature In targetFeatures
        sel.Clear
        sel.Add feature
        CATIA.StartCommand cmd
    Next
    sel.Clear
    
    partDoc.Part.Update

    MsgBox "Done"

End Sub

'外部リンクを持っているか判断
Private Function has_sourceElement( _
    ByVal feature As Solid) _
    As Boolean

    Dim dmy As AnyObject

    On Error Resume Next
    
    Set dmy = feature.SourceElement

    On Error GoTo 0
    
    has_sourceElement = IIf(dmy Is Nothing, False, True)

End Function

'言語取得
'return-ISO 639-1 code
'https://ja.wikipedia.org/wiki/ISO_639-1%E3%82%B3%E3%83%BC%E3%83%89%E4%B8%80%E8%A6%A7
Private Function GetLanguage() As String
    GetLanguage = "non"
    If CATIA.Windows.count < 1 Then Exit Function
    GetLanguage = "other"
    CATIA.ActiveDocument.Selection.Clear
    Dim st As String: st = CATIA.StatusBar
    Select Case True
        Case ExistsKey(st, "object")
            '英語-Select an object or a command
            GetLanguage = "en"
        Case ExistsKey(st, "objet")
            'フランス語-Selectionnez un objet ou une commande
            GetLanguage = "fr"
        Case ExistsKey(st, "Objekt")
            'ドイツ語-Ein Objekt oder einen Befehl auswahlen
            GetLanguage = "de"
        Case ExistsKey(st, "oggetto")
            'イタリア語-Selezionare un oggetto o un comando
            GetLanguage = "it"
        Case ExistsKey(st, "オブジェクト")
            '日本語-オブジェクトまたはコマンドを選択してください
            GetLanguage = "ja"
        Case ExistsKey(st, "объект")
            'ロシア語-Выберите объект или команду
            GetLanguage = "ru"
        Case ExistsKey(st, "象或")
            '中国語-???象或?羅
            GetLanguage = "zh"
        Case Else
            Select Case Len(st)
                Case 13
                    '韓国語-???? ?? ?? ?? unicode未対応の為
                    GetLanguage = "ko"
                Case 23
                    '日本語-日本語版以外のため
                    GetLanguage = "ja"
                Case Else
                    'それ以外
            End Select
    End Select
End Function

'文字列内に指定文字が存在するか?
'大文字小文字は無視
Private Function ExistsKey(ByVal txt As String, ByVal key As String) As Boolean
    ExistsKey = IIf(InStr(LCase(txt), LCase(key)) > 0, True, False)
End Function

アウトプット

年末年始辺りに、どれだったか忘れたのですが、
こちらのどれかを読みましたw
Qiita史上最多記録をつくろう!アウトプットはいいぞカレンダーのカレンダー | Advent Calendar 2022 - Qiita
これほど多くの方が・・・。

自分の成長の為にインプットは必要ですし、当然やるんですよね。
アウトプットは難しい。でもソフトウェア業界の方々は
やっているんですよ。非常に多くを目にします。
それに引き換え、製造業は・・・。
ソフトウェア業界の成長の速さはここでは無いでしょうか?

自己の成長にはアウトプット必要ですよ。
さらけ出した以上のリターンがあると感じてます。
・・・CADをネタにブログを続けるのは、結構難しいのは本音ですが。

3Dの画面の向きのベクトルを取得する

CATIA V5です。
ちょっと意味が分からなかったのですが、こちらを見つけました。
Re: Macro to create an Isometric View on a CATDrawing - DASSAULT: CATIA products - Eng-Tips

アイソメ図をマクロで作成する方法の様です。
オプションの設定を変更して、カメラの向きからベクトルを取得し、
DrawingViewを作成、再度オプションの設定を戻しているようです。
かなり面倒・・・。

カメラの向きを直す際、現状の "Up" と "Sight" のベクトルを取得し、
外積を使用しアイソメ方向となる "Sight" を設定を計算しています。
(up再設定した方が良い気もするけど・・・)
のX方向となる、右方向のベクトルを計算しています。
※変数を使いまわされていた為、解釈を間違えていました。
r1 Viewpoint3D (Object)


アイソメ図を作成する際の表示される6個の数値は、この2個のベクトル
ではないかな? と予測の元にサンプルを作りました。

'vba

Option Explicit

Sub CATMain()

    Dim viewer As Viewer3D
    Set viewer = CATIA.ActiveWindow.ActiveViewer
    
    Dim viewPoint As Variant 'Viewpoint3D
    Set viewPoint = viewer.Viewpoint3D
    
    '目線方向ベクトル
    Dim sightVector(2)
    viewPoint.GetSightDirection sightVector

    '上方向ベクトル
    Dim upVector(2)
    viewPoint.GetUpDirection upVector

    Dim msg As String
    msg = _
        "** 目線方向ベクトル **" & vbCrLf & _
        "X:" & sightVector(0) & vbCrLf & _
        "Y:" & sightVector(1) & vbCrLf & _
        "Z:" & sightVector(2) & vbCrLf & _
        vbCrLf & _
        "** 上方向ベクトル **" & vbCrLf & _
        "X:" & upVector(0) & vbCrLf & _
        "Y:" & upVector(1) & vbCrLf & _
        "Z:" & upVector(2)

    MsgBox msg
    
End Sub

過去に "Viewpoint3D" は何度か使ったことがあるので、
このブログをで検索してもらうと、ややこしいサンプルは
見つかると思います。

pythonの辞書で辞書内の値を使いたい

偶に、ジャイアンを表現したい時あるじゃないですか?

    ore_sama = {
        'First name': '武',
        'Last name': '剛田',
        'Nick name': 'ジャイアン',
        'Full name': '剛田武',
    }

これでも十分なの気もするのですが、人間将来の事は分からないんですよ。
もしですよ、ジャイアンが婿養子に行き、名字が変わった際
'Last name'を変更するだけでは無く、'Full name'も修正する必要がありますよね?

それは手間だし間違いの元だから、'Last name'を変更するだけ修正出来るように
したいな と思ったのが表題です。

つまりこんな感じで定義出来るのかな?いや無理かな?と思いまして。

    ore_sama = {
        'First name': '武',
        'Last name': '剛田',
        'Nick name': 'ジャイアン',
        'Full name': ore_sama['First name'] + ore_sama['Last name'],
    }

実際にやってみると・・・やっぱりエラーですね。
まぁ"ore_sama"が定義される前に"ore_sama"を使ったエラーに
なるとは思ってました。

じゃあこれでどう?

        'Full name': ['First name'] + ['Last name']

エラーが出なかったので、思わず "お!" って声が出たのですが、
確認すると、['First name', 'Last name'] と言うリストでした・・・。

ムリだな。恐らく "クラス作れ" って事だろうな。

ざっくりバルーン情報の取得

こちらで記載した通り、テキストと異なりバルーンの
領域は取得出来なかった為の苦肉の策です。
Drawのテキストサイズの取得 - C#ATIA

色々と試したのですがどうしてもダメな上、それらしき情報も
見つからない為、一時的に出来る限りバルーンに近い状態の
テキストを同じ位置に作成し、そのテキストから領域を
取得してみました。

'vba
'ざっくりバルーン領域

Option Explicit

Sub CATMain()
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sel As Selection
    Set sel = dDoc.Selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Add dDoc.sheets.ActiveSheet
    sel.Search "CATDrwSearch.DrwBalloon,sel"

    Dim balloons As Collection
    Set balloons = New Collection

    Dim i As Long
    For i = 1 To sel.Count2
        balloons.Add sel.Item(i).value
    Next
    
    sel.Clear

    CATIA.HSOSynchronized = True

    'ざっくりバルーン領域
    Dim bBox As Variant

    '三個だけ
    For i = 1 To 3
        bBox = get_balloon_bounding_box(balloons.Item(i))
        
        Dim msg As String
        msg = "** ざっくりバルーン情報 **" & vbCrLf & _
            "幅:" & bBox(2) - bBox(0) & vbCrLf & _
            "高さ:" & bBox(3) - bBox(1) & vbCrLf & _
            "中心座標 x:" & (bBox(2) + bBox(0)) * 0.5 & _
            " y:" & (bBox(3) + bBox(1)) * 0.5
        MsgBox msg
    Next
    
End Sub


'ざっくりバルーン領域
'return 0-minX, 1-minY, 2-maxX, 3-maxY
Private Function get_balloon_bounding_box( _
    ByVal balloon As DrawingText) _
    As Variant

    Dim view As DrawingView
    Set view = balloon.Parent.Parent
    
    Dim backUpLock
    backUpLock = view.LockStatus
    view.LockStatus = False

    Dim text As DrawingText
    Set text = create_text_from_balloon(balloon)
    
    Dim bBox As Variant
    bBox = get_text_bounding_box(text)

    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection

    sel.Clear
    sel.Add text
    sel.Delete

    view.LockStatus = backUpLock

    get_balloon_bounding_box = bBox
    
End Function


Private Function create_text_from_balloon( _
    ByVal balloon As DrawingText) _
    As DrawingText

    Dim view As DrawingView
    Set view = balloon.Parent.Parent

    Dim anchorPosition As String
    anchorPosition = balloon.anchorPosition
    
    Dim txtProps As DrawingTextProperties
    Set txtProps = balloon.TextProperties

    Dim cloneTxt As DrawingText
    Set cloneTxt = view.Texts.Add( _
        balloon.text, _
        balloon.x, _
        balloon.y _
    )
    
    cloneTxt.anchorPosition = balloon.anchorPosition

    Dim cloneProps As DrawingTextProperties
    Set cloneProps = cloneTxt.TextProperties

    cloneProps.Bold = txtProps.Bold
    cloneProps.FONTNAME = txtProps.FONTNAME
    cloneProps.FONTSIZE = txtProps.FONTSIZE
    cloneProps.FrameName = txtProps.FrameName
    cloneProps.FrameType = txtProps.FrameType
    cloneProps.Update
    
    Set create_text_from_balloon = cloneTxt

End Function


Private Function get_text_bounding_box( _
    ByVal drawText As DrawingText) _
    As Variant

    drawText.FrameType = catCircle

    Dim minLeader As DrawingLeader
    Set minLeader = drawText.Leaders.Add( _
        drawText.x - 100, _
        drawText.y - 100 _
    )
    
    Dim maxLeader As DrawingLeader
    Set maxLeader = drawText.Leaders.Add( _
        drawText.x + 100, _
        drawText.y + 100 _
    )

    Dim minX As Double
    Dim minY As Double
    minLeader.GetPoint 0, minX, minY

    Dim maxX As Double
    Dim maxY As Double
    maxLeader.GetPoint 0, maxX, maxY

    get_text_bounding_box = Array(minX, minY, maxX, maxY)
    
End Function

何故 "ざっくり" なのかと申しますと、こちらの画像の黒のバルーンに対して
一時的に作っているテキストは赤の部分で、かなり一致していない為です。

サイズ取得は、ズーム率を取得する為だけなので、厳密でなくても構わないと
思っているのですが、それだけの為にテキストを作って削除するのも
良いものかどうか・・・。