2D属性リンクを扱いたい2

こちらの続きです。
2D属性リンクを扱いたい1 - C#ATIA

属性リンクを使ったことが無い為、イロイロと確認です。

3DでXY平面状に点を作成し、2Dでテキストを作成。
属性リンクをH→X、V→Yとして作ります。

属性リンクパネルの「現行の選択」は多分、インターナルネームかな？
恐らく、式で利用できるパラメータ類が使えるのだろうと思います。

3D側で数値を変え、2D側を強制更新すると反映されます。

リンクしているにも関わらず、ビューのアイコンはリンクしていない
ものでも出来るので、軽く罠のような雰囲気です。
強制更新に関してはこちらが役に立ちそうです。
任意のビューのみを強制更新 - C#ATIA

編集-リンク　であればリンクしていることが確認出来ますね。

ここで疑問だったのが、参照しているものが削除された場合は
どうなるの？　か。

知らん顔してテキストはそのままなんですね。
何らかの確認方法を確立しなければならない雰囲気がヒシヒシと。
（属性リンク使わなきゃいいのに･･･）

属性リンクを作るのは、InsertVariableメソッド出来そうだな
とは感じているのですが、リンクを削除する方法が良くわからないです。
直接textプロパティを書き換えてしまう為、こんな手抜きなものを
実行します。

Sub CATMain()

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    Dim txt As DrawingText
    Set txt = dDoc.Sheets.ActiveSheet.views.ActiveView.Texts.Item(1)
    
    txt.Text = "hoge"

End Sub

実行だけしてみると

おーまた知らん顔してる。リンクしている要素無いのにリンクしてます
って出ちゃうんだ。属性リンクは同期しないんだなぁ。
強制更新してもダメでした。

ダブルクリック等でテキストエディターを立ち上げ終了すると

無事リンクが無くなってます。

便利以上に、リスクの方が大きいように感じるんだけどなぁ。

2D属性リンクを扱いたい1

3Dのパラメータ等の値を、2Dテキストにリンクさせた状態を作る方法を
薄々は知っていたのですが、「僕には関係ない」と思い調べずにいたのですが
使用する必要性が出てきた（逃げられそうに無い）ので、重い腰を上げる事に
しました。

Helpで調べたり、頂いた資料を眺めたり、知人に相談したり、サポートに
問い合わせてみたり･･･。使い方は直ぐにわかったのですが、量が多いため
劇的にメンドクサイ。

調べてみるとマクロでも作成出来そうなことはわかりました。
あまり良いサンプルが見つからなかったのですが、
こちらでチラッと出てくる、InsertVariableメソッドがそのようです。
Macro To Add Additional Sheets to a Drawing - DASSAULT: CATIA products - Eng-Tips

これですね。
r1 DrawingText (Object)

困るのが、何処を参照しているのか？　の確認方法です。
あのメソッド名からしても、戻り値で参照先を
得られそうに無いです。
他のプロパティ・メソッドでも得られそうな気がしないのですが、
どうでしょうか？

属性リンクを作ったその時は、まだ不安も無いのですが、
時間が経てば正しい参照先なのかどうか？　の不安が残りませんか?

唯一確認出来そうな方法が、編集-リンクで表示されるダイアログ
のような気がするので、こちらを利用すれば可能なのかと
感じております。
3D CAD Model Collection | GrabCAD Community Library
ﾌｧｲﾙ間ﾘﾝｸの取得6 - C#ATIA
ﾌｧｲﾙ間ﾘﾝｸの取得7 - C#ATIA

届くかな？

断面図から断面を切った位置の座標値を取得

こちらでコメント頂いた
「断面図から断面を切った位置の座標値を取得」
についてです。
図面の断面のネーミング - C#ATIA

結論から書くと、取得出来そうに有りませんでした。
念のためこんな感じのコードは作りました。

'vba using-'KCL0.0.12'  by Kantoku
'断面図から断面元のビューと断面数の取得

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    '断面図選択
    Dim msg As String
    msg = "DrawViewを選択して下さい : ESCｷｰ 終了"
    
    Dim secvi As DrawingView
    Set secvi = SelViewSection(msg)
    If secvi Is Nothing Then Exit Sub
    
    '断面元取得
    Dim refvi As DrawingView
    Set refvi = secvi.ReferenceView
    If refvi Is Nothing Then
        MsgBox "断面図の元のビューが取得出来ませんでした"
        Exit Sub
    End If
    
    '断面数取得
    Dim seccnt As Long
    seccnt = GetSectCount(refvi)
    
    msg = "選択ビュー:" & secvi.name & vbCrLf & _
          "断面元ビュー:" & refvi.name & vbCrLf & _
          "断面元の断面数:" & seccnt
    MsgBox msg
    
End Sub

Private Function GetSectCount( _
    vi As DrawingView) As Long
    
    CATIA.HSOSynchronized = False
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
    
    With sel
        .Clear
        .Add vi
        .Search "(CATDrwSearch.DrwCallout),sel"
        GetSectCount = .Count2
        .Clear
    End With
    
    CATIA.HSOSynchronized = True
    
End Function

Private Function SelViewSection( _
    ByVal msg) As DrawingView
    
    Set SelViewSection = Nothing
    Dim vi As DrawingView
    
Continue:
    Set vi = SelectItem(msg, "DrawingView")
    If vi Is Nothing Then Exit Function
    
    If vi.ViewType = catViewSection Then
        Set SelViewSection = vi
        Exit Function
    End If
    
    MsgBox "断面のビューを選択してください"
    GoTo Continue
End Function

断面元のビューの特定は可能ですが、断面のライン自体が取得出来ませんでした。
(Arrowは、本当に矢印の要素でした)

可能な事は、上記で示したとおり検索でヒットさせる方法ですが
ここからオブジェクトを取得しても、DrawingViewとなってしまい
実質マクロで扱うのは不可能だと判断しました。

「どうしても」となれば、3Dとのリンクを分断することで断面の線が
単なる線となる為、これを何かしらの方法で座標値を見つける事が
出来るかも知れませんが、リンクを切るのはリスクの方が大きいようにも
感じます。（マクロでUndoを行えば、戻るのは確かですが･･･）

安全を考慮してビュー自体を何処かにコピペして、分断出来れば
良いのですが、ビューのコピペでは断面の線はコピー出来ないようなので
お手上げです。

曲線の始点終点どっちが近いのかな？判断

これ、誰も答えないのでマクロを作ろうかな？　と思っているのですが
Catia VBA startpoint, endpoint - DASSAULT: CATIA products - Eng-Tips
思ったより手強い。

スプラインだけじゃなく、直線・円弧にも対応させて、
閉じているかどうかもチェックしたいのですが、時間が無いです。

直線：FirstUptoElemとSecondUptoElemでリファレンス取得し距離測定

円弧：中心と半径と始点ベクトルと終点ベクトル使ってかな？
　　　始点終点のリファレンスは取れないのかな？
r1 HybridShapeCircle (Object)

スプライン：GetNbControlPointでポイント数取得して
　　　　　　GetPointで最初と最後のリファレンス取得し距離測定かな？
r1 HybridShapeSpline (Object)

一時的に曲線上に点を作成して、距離測定したほうが手っ取り早いのに･･･。
HybridShapeFactory内だけで処理すれば、ゴミ残らないんだけどなぁ。

ショートカットキーにマクロを登録する

こちらのコメントで御質問頂いただきました。

最初の質問の方です。式では該当する機能があるものかどうか、不明です。
マクロであれば形状セット数の取得は簡単に出来ます。

'vba パラメータに形状セット数を表示する

Sub CATMain()
    '本来ならドキュメントの型をチェックすべきです。
    'Part以外がアクティブな場合エラーになります。
    
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As Part
    Set pt = doc.Part
    
    Dim prms As Parameters
    Set prms = pt.Parameters
    
    'パラメータ取得
    Dim prm As IntParam
    Set prm = GetPrm(prms, "形状セット数")

    '形状セット数
    Dim hBdyCount As Long
    hBdyCount = GetHBodyCount(doc)
    
    'パラメータ値に反映
    prm.Value = hBdyCount
End Sub

Private Function GetHBodyCount( _
    ByVal doc As Document) As Long
    
    Dim sel As selection
    Set sel = doc.selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Search "CATPrtSearch.OpenBodyFeature,all"
    GetHBodyCount = sel.Count2
    sel.Clear
    
    CATIA.HSOSynchronized = True
End Function

Private Function GetPrm( _
    ByVal prms As Parameters, _
    ByVal name As String) As IntParam
    
    If IsExistPrm(prms, name) Then
        Set GetPrm = prms.Item(name)
    Else
        Set GetPrm = InitParm(prms, name)
    End If
End Function

Private Function IsExistPrm( _
    ByVal prms As Parameters, _
    ByVal name As String) As Boolean
    
    Dim intPrm As IntParam
    
    On Error Resume Next
        Set intPrm = prms.Item(name)
    On Error GoTo 0

    IsExistPrm = IIf(intPrm Is Nothing, False, True)
End Function

Private Function InitParm( _
    ByVal prms As Parameters, _
    ByVal name As String) As IntParam

    Set InitParm = prms.CreateInteger("", 0)
    InitParm.Rename name
End Function

紛らわしい為、パラメータ名は "形状セット数" としました。
Partファイルでのみですが、実行すれば取得できます。

ここで困難なのは "リアルタイムで" の部分です。
プログラム的に考えれば、変化が起きたタイミングの検知し
このマクロを実行すれば良いのですが、通常であれば
イベント処理が真っ先に思いつきます。　
が、生憎CATIAのマクロでは、そのようなイベント処理を
行うことは出来ないだろうと思います。

おぼろげな記憶なのですが、やはり "リアルタイムで" を実行する
代案として「unofficial catia user forum」にここなさんが記載していた
アイデアをご紹介します。

作業中に頻繁に使用するショートカットキーがあるでしょうか？
仮にこれが「Treeの表示/非表示」だとします。（僕は偶にです･･･）
デフォルトであれば F3キーとなっています。
このF3キーを押した際、「Treeの表示/非表示」とマクロの実行を
一度で行えるようにする　と言うアイデアです。

すんなり出来ない、ショートカットキーのカスタマイズについては
こちらのサイトに詳しく記載されています。
〇CATIAの小技
登録できないアクセサレーターを登録する方法 | CATIAの小技

1）重複したシュートカットキーの登録が出来ない為、一度F3キーを
フリーにします。

日本語環境の場合ですが、「Treeの表示/非表示」は「仕様」と言う
コマンド名です。（知らなかった･･･）
アクセレータに「F3」が記載されていますので、これを空欄にします。

2）「CATIAの小技」さんの手法でツールバーを作成します。

3）「CATIAの小技」さんの手法でツールバーにマクロをD&Dします。
　念のため、ツールバーに登録する前は、アクセレータはグレーアウトして
　設定できません。

　登録するとアクセレータでの設定が可能となりますので、「F3」と
　記入すればOKです。

4）これでF3キーでマクロは実行するようになりますが、元の
　「Treeの表示/非表示」が出来なくなってしまいます。その為
　最初のマクロを少し修正します。

'vba パラメータに形状セット数を表示する

Sub CATMain()
    '本来ならドキュメントの型をチェックすべきです。
    'Part以外がアクティブな場合エラーになります。
    
    '仕様コマンド
    CATIA.StartCommand "仕様"
    
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument

    '以下は同じです    
・
・
・

このようにすることで、Treeの表示/非表示」とマクロの実行を
一度で行えるようなります。
・・・ちっともリアルタイムには、ならないのですが。

上書き保存確認ダイアログでの判断

「SaveAsで保存する際、上書き保存確認ダイアログで
　"はい" を選択したか "いいえ" を選択したか、判断したい」
と御質問を頂きました。

SaveAsメソッドは戻り値がない為、保存前と保存後のタイムスタンプで
判断するしか方法が無いような気がします。

'vba
Sub CATMain()
    
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    Dim before As Date
    before = GetDateLastModified(doc.FullName)
    
    '上書きでいいえの場合エラーになる為
    On Error Resume Next
        doc.SaveAs doc.FullName
    On Error GoTo 0
    
    If before = GetDateLastModified(doc.FullName) Then
        MsgBox "保存されていません"
    Else
        MsgBox "保存されました"
    End If
    
End Sub

Private Function GetDateLastModified( _
    ByVal path As String) As Date
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    GetDateLastModified = fso.GetFile(path).DateLastModified
End Function

色々を確認が足りないと思いますが、一応判断出来ていると思います。
過去に、マクロで保存を行うことに対しての賛否はありましたが･･･。

Tree順にボディ,形状セット,時系列形状セット名の取得

先日見つけたこちらのトピですが、
CATIA V5 - CATScript - Identify Order of Geometric Sets and Bodies in CATPart - DASSAULT: CATIA products - Eng-Tips
Treeに並んでいる順に、ボディと形状セット名を取得したい
と言う内容です。

検索で選択状態にすれば、Tree順に取得出来たはずなので
サンプルを作ってみたのですが、よく読んだら解決されていた
いたようでした・・・。　折角作ったので記載しておきます。

Treeに直接ぶら下がっているものだけで、子以下のものは取得しません。

'VBA Tree順にボディ,形状セット,時系列形状セット名の取得

Option Explicit

Sub CATMain()

    'start check
    If Not CanExecute("PartDocument") Then Exit Sub
    
    'doc
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    'AllContainer
    Dim bodys As Object
    Set bodys = GetAllContainers(doc)
    If bodys Is Nothing Then
        MsgBox "Element not found", vbExclamation
        Exit Sub
    End If
    
    'LeafContainer
    Set bodys = GetLeafContainerNames(doc, bodys)
    If bodys Is Nothing Then
        MsgBox "Element not found", vbExclamation
        Exit Sub
    End If
    
    'done
    MsgBox Join(bodys.ToArray(), vbCrLf)
End Sub

Private Function GetAllContainers( _
    ByVal doc As PartDocument) As Object
    
    Set GetAllContainers = Nothing
    
    Dim sel As selection
    Set sel = doc.selection
    
    'Search
    Dim word As String
    word = "(CATPrtSearch.BodyFeature + " & _
            "CATPrtSearch.OpenBodyFeature + " & _
            "CATPrtSearch.MMOrderedGeometricalSet),in"
    
    CATIA.HSOSynchronized = False
    sel.Clear
    
    sel.Search word
    If sel.Count2 < 1 Then Exit Function
    
    Dim ary As Object
    Set ary = InitLst()
    
    Dim i As Long
    For i = 1 To sel.Count2
        ary.Add sel.Item(i).Value
    Next
    
    sel.Clear
    CATIA.HSOSynchronized = True
    
    Set GetAllContainers = ary
End Function

Private Function GetLeafContainerNames( _
    ByVal doc As PartDocument, _
    ByVal lst As Object) As Object
    
    Set GetLeafContainerNames = Nothing
    
    'Leaf HybridBodies
    Dim hBdys As Variant
    hBdys = Lst2Ary(doc.Part.HybridBodies)
    
    'Leaf OrderedGeometricalSets
    Dim odrds As Variant
    odrds = Lst2Ary(doc.Part.OrderedGeometricalSets)
    
    'is Leaf?
    Dim leafs As Object
    Set leafs = InitLst()
    
    Dim v As Variant
    For Each v In lst
        Select Case TypeName(v)
            Case "Body"
                If v.InBooleanOperation = False Then
                    leafs.Add v.Name
                End If
            Case "HybridBody"
                If UBound(filter(hBdys, GetInternalName(v))) > -1 Then
                    leafs.Add v.Name
                End If
            Case "OrderedGeometricalSet"
                If UBound(filter(odrds, GetInternalName(v))) > -1 Then
                    leafs.Add v.Name
                End If
        End Select
    Next
    If leafs.count < 1 Then Exit Function
    
    Set GetLeafContainerNames = leafs
End Function

'list2array
Private Function Lst2Ary( _
    ByVal lst As Object) As Variant

    If lst.count < 1 Then Exit Function

    Dim ary As Object
    Set ary = InitLst()
    
    Dim v As Variant
    For Each v In lst
        ary.Add GetInternalName(v)
    Next
    
    Lst2Ary = ary.ToArray()
End Function

'InternalName
Private Function GetInternalName( _
    ByVal AOj As AnyObject) As String
    If AOj Is Nothing Then
        GetInternalName = Empty
        Exit Function
    End If
    GetInternalName = AOj.GetItem("ModelElement").InternalName
End Function

'DotNet ArrayList
Private Function InitLst() As Object
    Set InitLst = CreateObject("System.Collections.ArrayList")
End Function

'OK?
Private Function CanExecute( _
    ByVal docType As String) As Boolean
    
    CanExecute = False
    
    If CATIA.Windows.count < 1 Then
        MsgBox "Please open the file", vbExclamation
        Exit Function
    End If
    
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    If Not TypeName(doc) = docType Then
        MsgBox docType & " Only!", vbExclamation
        Exit Function
    End If
    
    CanExecute = True
End Function