C#ATIA

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

DrawingTextの位置リンク

こちらのコメントを頂いたので、DrawingTextの位置リンクのマクロを作成
してみました。
Viewに基準線を入れる2 - C#ATIA


準備として直線とテキストを1つずつ作成してください。
(味気なかったのでテキストにフレーム表示させていますが、マクロの実行には無関係です。)
f:id:kandennti:20150612115500p:plain

マクロを実行するとMsgBoxが表示されるので、位置リンクの作成と削除どちらかを
選択して下さい。
○位置リンクの作成
 最初にテキストを選択し、続いて直線を選択で終了。
 直線の端点を移動させると、テキストも一緒に移動する事を確認してください。
○位置リンクの削除
 位置リンクが付いているテキストを選択して終了。
 元々リンクされていた要素を移動しても、テキストが移動されない事を確認して
 ください。

VBAのコードです。

Private Actdoc As DrawingDocument

Sub CATMain()
    '準備
    Set Actdoc = CATIA.ActiveDocument
    Dim Msg As String
    Msg = "-- 作業を選択して下さい --" + vbCrLf
    Msg = Msg + "は い:位置リンクの作成" + vbCrLf
    Msg = Msg + "いいえ:位置リンクの削除" + vbCrLf
    Msg = Msg + "キャンセル:中止"
    
    Select Case MsgBox(Msg, vbYesNoCancel)
        Case vbYes
            SetPositionalLink
        Case vbNo
            DelPositionalLink
    End Select
End Sub

Private Sub DelPositionalLink()
    'Text指定
    Dim Txt As DrawingText
    Dim Filter(0) As Variant
    Dim Msg As String
    Filter(0) = "DrawingText"
    Msg = "位置リンクを削除するテキストを選択して下さい /ESC=キャンセル"
    Set Txt = SelectItem(Filter, Msg)
    
    '位置リンク削除
    'NullもNothingもNG ダミー要素を作り一度Linkさせダミーを削除
    Dim View As DrawingView
    Set View = Txt.Parent.Parent
    Dim Dmy As DrawingText
    Set Dmy = View.Texts.Add("temp", 0, 0)
    Txt.AssociativeElement = Dmy
    Call DeleteItem(Dmy)
End Sub

Private Sub SetPositionalLink()
    'Text指定
    Dim Txt As DrawingText
    Dim Filter(0) As Variant
    Dim Msg As String
    Filter(0) = "DrawingText"
    Msg = "位置リンクを行うテキストを選択して下さい /ESC=キャンセル"
    Set Txt = SelectItem(Filter, Msg)
    
    'ライン指定
    Dim Line As Line2D
    Filter(0) = "Line2D"
    Msg = "位置リンク先のラインを選択して下さい /ESC=キャンセル"
    Set Line = SelectItem(Filter, Msg)
    
    '位置リンク作成
    Txt.AssociativeElement = Line
End Sub

Private Function SelectItem(Filter, Msg As String) As AnyObject
    Dim Status As String
    Dim Sel 'As selection
    Set Sel = Actdoc.Selection
    With Sel
        Call .Clear
        Status = .SelectElement2(Filter, Msg, False)
        If Status = "Cancel" Then
            Call MsgBox("中止します")
            End
        End If
        Set SelectItem = .Item(1).Value
        Call .Clear
    End With
    Set Sel = Nothing
End Function

Private Sub DeleteItem(Item As AnyObject)
    With Actdoc.Selection
        Call .Clear
        Call .Add(Item)
        Call .Delete
    End With
End Sub

要はDrawingTextクラスのAssociativeElementプロパティです。
位置リンクの作成は、過去にやったことがあったのですが、
削除は思っているより苦労しました。
(NullやNothingの代入ではエラー)