寸法線の値を取得しテキストを追記するマクロ｜CATIAマクロの作成方法

今回の記事はマクロ案募集でいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ: ドラフティング
　
マクロ案:
CATIA Drawingの“寸法コマンドで作図された寸法線の下に、
テキストエディターで下図のようなオブジェクト”をマクロで作図することは可能でしょうか?
(テキストには、寸法線に対して、位置リンクも付加したいです。)

お問い合わせの内容からすると、「複数の寸法線に対して一括でテキストボックスを作成する」という内容のようですが、ここではコード解説のし易さから「選択された1つの寸法線に対してテキストボックスを作成する」という内容になっています。

コードの内容さえ理解できれば、ループ文を使って一括で作成するコードにすぐに書き換えることができるので、まずはコードを理解するところから始めることをオススメします。

1. マクロの機能
2. サンプルコード
3. コード解説
4. まとめ

マクロの機能

今回作成したマクロは上画像の通り寸法線の下にテキストボックスを作成するマクロです。
(※ 画像クリックで拡大)

具体的な機能は以下のとおりです。

マクロの機能まとめ・選択した寸法線の下にテキストボックスを作成
・テキストボックスの値は画面に表示されている寸法線と同じ値
・シンボルの部分は「*」に置き換える
・テキストボックスには寸法線との位置リンクを作成する

シンボルの部分を「*」に置き換えるのは、VBAでテキストの値にシンボルを追加することができないためです。(実際はできるのかもしれませんが)

サンプルコード

マクロのコードは以下のとおりです。

Sub CATMain()

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
        MsgBox "CATDrawingのみ対応のマクロです。"
        Exit Sub
    End If

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
  'Selection定義
    Dim sel 'As Selection
    Set sel = doc.Selection
    sel.Clear
    
  'ﾕｰｻﾞｰ選択
    Dim filter: filter = Array("DrawingDimension")
    Dim msg As String: msg = "寸法を選択して下さい。"
    Dim status As String
    status = sel.SelectElement2(filter, msg, False)
    If status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
  '寸法線を取得
    Dim DrwDim 'As DrawingDimension
    Set DrwDim = sel.Item(1).Value

    
'****************************************************
'               寸法線情報の取得
'****************************************************
    
  '寸法線のﾋﾞｭｰを定義
    Dim DimView As DrawingView
    Set DimView = DrwDim.Parent.Parent

  '寸法値の座標を取得
    Dim DimCoords(1)
    Call DrwDim.GetBoundaryBox(DimCoords)

  'DrawingDimValueの取得
    Dim DimVal As DrawingDimValue
    Set DimVal = DrwDim.GetValue
    
  '寸法値の精度のﾌｫｰﾏｯﾄを取得
    Dim DimValPre As Double
    DimValPre = DimVal.GetFormatPrecision(1)
    
    Dim DimValPreFormat As String
    DimValPreFormat = Str(DimValPre)
    DimValPreFormat = Replace(DimValPreFormat, 1, 0)
    
  '画面に表示されている寸法値の取得
    Dim TxtValue As String
    TxtValue = Format(DimVal.Value, DimValPreFormat)
    TxtValue = Trim(TxtValue)
    
  '寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得
    Dim BeforeTxt As String
    Dim AfterTxt As String
    
    Call DimVal.GetBaultText(1, BeforeTxt, AfterTxt, "", "")
    
  'ｼﾝﾎﾞﾙの有無を確認
    Dim BeforeSym As String
    Dim AfterSym As String
    
    Call DimVal.GetPSText(1, BeforeSym, AfterSym)
  
    
  'ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正
  '① ｼﾝﾎﾞﾙ部分に「*」を追加
    If BeforeSym = "R" Then
        TxtValue = "R" & TxtValue
    ElseIf BeforeSym <> "" Then
        TxtValue = "*" & TxtValue
    ElseIf AfterSym <> "" Then
        TxtValue = TxtValue & "*"
    End If
    
    
  '②寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)の追加
    If AfterTxt = "HOLE" Then
        AfterTxt = "穴"
    End If
    
    If AfterTxt = "DRILL" Then
        AfterTxt = "キリ"
    End If
  
    TxtValue = BeforeTxt & TxtValue & AfterTxt
    
    
'****************************************************
'                  ﾃｷｽﾄﾎﾞｯｸｽ作成
'****************************************************
    
  '寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定
    Dim margin As Double
    margin = 3

  'ﾃｷｽﾄﾎﾞｯｸｽ作成
    Dim Txt As DrawingText
    Set Txt = DimView.Texts.Add(TxtValue, DimCoords(0), DimCoords(1) - margin)
    
    With Txt.TextProperties
        .AnchorPoint = catMiddleLeft    'ｱﾝｶｰﾎﾟｲﾝﾄ
        .FONTSIZE = 4.5                 'ﾌｫﾝﾄｻｲｽﾞ
        .FONTNAME = "KANJI"             'ﾌｫﾝﾄ
        .Color = -743277057             'ﾃｷｽﾄｶﾗｰ
    End With
  
  '位置ﾘﾝｸ作成
    Txt.AssociativeElement = DrwDim
    
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

Sub CATMain()

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認

If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then

MsgBox "CATDrawingのみ対応のマクロです。"

Exit Sub

End If

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義

Dim doc As DrawingDocument

Set doc = CATIA.ActiveDocument

'Selection定義

Dim sel 'As Selection

Set sel = doc.Selection

sel.Clear

'ﾕｰｻﾞｰ選択

Dim filter: filter = Array("DrawingDimension")

Dim msg As String: msg = "寸法を選択して下さい。"

Dim status As String

status = sel.SelectElement2(filter, msg, False)

If status <> "Normal" Then

MsgBox "キャンセルします。"

Exit Sub

End If

'寸法線を取得

Dim DrwDim 'As DrawingDimension

Set DrwDim = sel.Item(1).Value

'****************************************************

' 寸法線情報の取得

'****************************************************

'寸法線のﾋﾞｭｰを定義

Dim DimView As DrawingView

Set DimView = DrwDim.Parent.Parent

'寸法値の座標を取得

Dim DimCoords(1)

Call DrwDim.GetBoundaryBox(DimCoords)

'DrawingDimValueの取得

Dim DimVal As DrawingDimValue

Set DimVal = DrwDim.GetValue

'寸法値の精度のﾌｫｰﾏｯﾄを取得

Dim DimValPre As Double

DimValPre = DimVal.GetFormatPrecision(1)

Dim DimValPreFormat As String

DimValPreFormat = Str(DimValPre)

DimValPreFormat = Replace(DimValPreFormat, 1, 0)

'画面に表示されている寸法値の取得

Dim TxtValue As String

TxtValue = Format(DimVal.Value, DimValPreFormat)

TxtValue = Trim(TxtValue)

'寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得

Dim BeforeTxt As String

Dim AfterTxt As String

Call DimVal.GetBaultText(1, BeforeTxt, AfterTxt, "", "")

'ｼﾝﾎﾞﾙの有無を確認

Dim BeforeSym As String

Dim AfterSym As String

Call DimVal.GetPSText(1, BeforeSym, AfterSym)

'ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正

'① ｼﾝﾎﾞﾙ部分に「*」を追加

If BeforeSym = "R" Then

TxtValue = "R" & TxtValue

ElseIf BeforeSym <> "" Then

TxtValue = "*" & TxtValue

ElseIf AfterSym <> "" Then

TxtValue = TxtValue & "*"

End If

'②寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)の追加

If AfterTxt = "HOLE" Then

AfterTxt = "穴"

End If

If AfterTxt = "DRILL" Then

AfterTxt = "キリ"

End If

TxtValue = BeforeTxt & TxtValue & AfterTxt

'****************************************************

' ﾃｷｽﾄﾎﾞｯｸｽ作成

'****************************************************

'寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定

Dim margin As Double

margin = 3

'ﾃｷｽﾄﾎﾞｯｸｽ作成

Dim Txt As DrawingText

Set Txt = DimView.Texts.Add(TxtValue, DimCoords(0), DimCoords(1) - margin)

With Txt.TextProperties

.AnchorPoint = catMiddleLeft 'ｱﾝｶｰﾎﾟｲﾝﾄ

.FONTSIZE = 4.5 'ﾌｫﾝﾄｻｲｽﾞ

.FONTNAME = "KANJI" 'ﾌｫﾝﾄ

.Color = -743277057 'ﾃｷｽﾄｶﾗｰ

End With

'位置ﾘﾝｸ作成

Txt.AssociativeElement = DrwDim

End Sub

コード解説

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
        MsgBox "CATDrawingのみ対応のマクロです。"
        Exit Sub
    End If

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認

If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then

MsgBox "CATDrawingのみ対応のマクロです。"

Exit Sub

End If

まず、はじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
　

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
  'Selection定義
    Dim sel 'As Selection
    Set sel = doc.Selection
    sel.Clear

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義

Dim doc As DrawingDocument

Set doc = CATIA.ActiveDocument

'Selection定義

Dim sel 'As Selection

Set sel = doc.Selection

sel.Clear

アクティブドキュメントとSelectionの定義を行います。
Selectionの定義の際は「As Selection」と定義せずに、Variant型で定義をします。
これは以降で「SelectElement2メソッド」を利用できるようにするためです。
　

ﾕｰｻﾞｰ選択

  'ﾕｰｻﾞｰ選択
    Dim Filter: Filter = Array("DrawingDimension")
    Dim msg As String: msg = "寸法を選択して下さい。"
    Dim Status As String
    Status = sel.SelectElement2(Filter, msg, False)
    If Status <> "Normal" Then
        MsgBox "キャンセルします。"
        Exit Sub
    End If

  '寸法線を取得
    Dim DrwDim As DrawingDimension
    Set DrwDim = sel.Item(1).Value

'ﾕｰｻﾞｰ選択

Dim Filter: Filter = Array("DrawingDimension")

Dim msg As String: msg = "寸法を選択して下さい。"

Dim Status As String

Status = sel.SelectElement2(Filter, msg, False)

If Status <> "Normal" Then

MsgBox "キャンセルします。"

Exit Sub

End If

'寸法線を取得

Dim DrwDim As DrawingDimension

Set DrwDim = sel.Item(1).Value

「SelectElement2メソッド」を使ってユーザーに寸法線を選択させます。
(SelectElement2の詳しい使い方は上記リンクページを参照下さい)

このとき選択された寸法線は変数「DrwDim」に格納します。
　

寸法線のﾋﾞｭｰを定義

  '寸法線のﾋﾞｭｰを定義
    Dim DimView As DrawingView
    Set DimView = DrwDim.Parent.Parent

'寸法線のﾋﾞｭｰを定義

Dim DimView As DrawingView

Set DimView = DrwDim.Parent.Parent

ユーザーが選択した寸法線があるビューを取得します。
「DrawingDimension」の親のオブジェクトは「DrawingDimensions」、
「DrawingDimensions」の親のオブジェクトは「DrawingView」です。

つまり「DrwDim」の親の親が「DrwDim」があるビューを表します。
よって「DrwDim.Parent.Parent」＝「DrwDimがあるビュー」を表します。
　

寸法値の座標を取得

  '寸法値の座標を取得
    Dim DimCoords(1)
    Call DrwDim.GetBoundaryBox(DimCoords)

'寸法値の座標を取得

Dim DimCoords(1)

Call DrwDim.GetBoundaryBox(DimCoords)

寸法線の寸法値部分の座標を取得します。
寸法値の座標を取得するには「DrawingDimensionオブジェクト」の「GetBoundaryBoxメソッド」を使います。このメソッドでは寸法値の４隅の座標を取得することができます。

ここでは寸法値の左下のみの座標を取得しています。
ちなみに配列の要素数を増やすとそれぞれ以下の通りの座標が取得できます。

DimCoords(0) → 寸法値の左下 X座標
DimCoords(1) → 寸法値の左下 Y座標
DimCoords(2) → 寸法値の右下 X座標
DimCoords(3) → 寸法値の右下 Y座標
DimCoords(4) → 寸法値の左上 X座標
DimCoords(5) → 寸法値の左上 Y座標
DimCoords(6) → 寸法値の右上 X座標
DimCoords(7) → 寸法値の右上 Y座標

　
DrawingDimValueの取得

  'DrawingDimValueの取得
    Dim DimVal As DrawingDimValue
    Set DimVal = DrwDim.GetValue

'DrawingDimValueの取得

Dim DimVal As DrawingDimValue

Set DimVal = DrwDim.GetValue

「DrawingDimValueオブジェクト」を取得します。
このオブジェクトのプロパティ/メソッドを使うことで、寸法値に関する操作を行うことが可能になります。以降では「寸法値の取得」「寸法値のフォーマットの取得」「関連テキストの取得」「シンボルの取得」の際にこのオブジェクトを使用します。
　

寸法値の精度のﾌｫｰﾏｯﾄを取得

  '寸法値の精度のﾌｫｰﾏｯﾄを取得
    Dim DimValPre As Double
    DimValPre = DimVal.GetFormatPrecision(1)
    
    Dim DimValPreFormat As String
    DimValPreFormat = Str(DimValPre)
    DimValPreFormat = Replace(DimValPreFormat, 1, 0)

'寸法値の精度のﾌｫｰﾏｯﾄを取得

Dim DimValPre As Double

DimValPre = DimVal.GetFormatPrecision(1)

Dim DimValPreFormat As String

DimValPreFormat = Str(DimValPre)

DimValPreFormat = Replace(DimValPreFormat, 1, 0)

寸法値の「精度」を取得します。寸法値の精度は「DrawingDimValueオブジェクト」の「GetFormatPrecisioメソッド」で取得できます。

寸法値における「精度」とは画面上に表示されている寸法値の有効数字のことを指します。
例えば「5.2」の場合の精度は「0.1」
「5.23」の場合の精度は「0.01」
「5.234」の場合の精度は「0.001」となります。

以降で寸法値の値を取得しますが、その値はかなり細かいものになってしまいます。
最終的にはFormat関数で現在画面上で表示されている値と同じにするため、ここで精度のフォーマットを作成しておきます。

具体的には取得した精度が「0.1」の場合は「0.0」、「0.01」の場合は「0.00」のように全て「0」になるように変換します。(※このとき変数の型をString型にしておかないと、全て「0」に丸められてしまうので注意)
　

画面に表示されている寸法値の取得

  '画面に表示されている寸法値の取得
    Dim TxtValue As String
    TxtValue = Format(DimVal.Value, DimValPreFormat)
    TxtValue = Trim(TxtValue)

'画面に表示されている寸法値の取得

Dim TxtValue As String

TxtValue = Format(DimVal.Value, DimValPreFormat)

TxtValue = Trim(TxtValue)

画面上で表示されている寸法値を取得します。
寸法値は「DrawingDimValueオブジェクト」の「Valueプロパティ」より取得できます。

ただ先にもいっている通り、これで取得できる値は非常に細かいものとなってしまいます。
そこで上記で作成した寸法値の精度のフォーマット(0.0や0.00)とFormat関数を使い、寸法値を画面上に表示されている値と同じになるように丸めます。
　

寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得

  '寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得
    Dim BeforeTxt As String
    Dim AfterTxt As String
    
    Call DimVal.GetBaultText(1, BeforeTxt, AfterTxt, "", "")

'寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得

Dim BeforeTxt As String

Dim AfterTxt As String

Call DimVal.GetBaultText(1, BeforeTxt, AfterTxt, "", "")

関連テキストの取得を行います。
関連テキストとは寸法値の上下左右に入力されたテキストのことです。
ここでは上下の関連テキストは無視し、左右の関連テキストのみを取得していきます。

関連テキストを取得するには「DrawingDimValueオブジェクト」の「GetBaultTextメソッド」を使い以下のように書きます。

GetBaultTextメソッド

DimVal.GetBaultText Index, BeforeTxt, AfterTxt, UpperTxt, LowerTxt

取得する関連テキストがメイン値の場合はIndexに「1」を、二重値の場合はIndexに「2」を入力します。

結果として、それぞれの変数に下記の通り各エリアの関連テキストの値が格納されます。

BeforeTxt → 関連テキスト左側の値
AfterTxt → 関連テキスト右側の値
UpperTxt → 関連テキスト上側の値
LowerTxt → 関連テキスト下側の値

この時、変数の代わりに「””」と入力することでその部分の取得を無視することもできます。
　

ｼﾝﾎﾞﾙの有無を確認

  'ｼﾝﾎﾞﾙの有無を確認
    Dim BeforeSym As String
    Dim AfterSym As String
    
    Call DimVal.GetPSText(1, BeforeSym, AfterSym)

'ｼﾝﾎﾞﾙの有無を確認

Dim BeforeSym As String

Dim AfterSym As String

Call DimVal.GetPSText(1, BeforeSym, AfterSym)

寸法値のシンボル(「Φ」や「±」など)を取得します。

シンボルを取得するには「DrawingDimValueオブジェクト」の「GetPSTextメソッド」を使い以下のように書きます。

GetPSTextメソッド

DimVal.GetPSText Index, BeforeSym, AfterSym

取得する関連テキストがメイン値の場合はIndexに「1」を、二重値の場合はIndexに「2」を入力します。

結果として、それぞれの変数に下記の通り前後のシンボルの値が格納されます。
(「<DIAMETER>」や「<PLUSMINUS>」のようにシンボル名が文字列として取得できます)

BeforeSym → 左側のシンボル
AfterSym → 右側のシンボル

ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正

  'ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正
  '① ｼﾝﾎﾞﾙ部分に「*」を追加
    If BeforeSym = "R" Then
        TxtValue = "R" & TxtValue
    ElseIf BeforeSym <> "" Then
        TxtValue = "*" & TxtValue
    ElseIf AfterSym <> "" Then
        TxtValue = TxtValue & "*"
    End If
    
    
  '②寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)の追加
    If AfterTxt = "HOLE" Then
        AfterTxt = "穴"
    End If
    
    If AfterTxt = "DRILL" Then
        AfterTxt = "キリ"
    End If
  
    TxtValue = BeforeTxt & TxtValue & AfterTxt

'ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正

'① ｼﾝﾎﾞﾙ部分に「*」を追加

If BeforeSym = "R" Then

TxtValue = "R" & TxtValue

ElseIf BeforeSym <> "" Then

TxtValue = "*" & TxtValue

ElseIf AfterSym <> "" Then

TxtValue = TxtValue & "*"

End If

'②寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)の追加

If AfterTxt = "HOLE" Then

AfterTxt = "穴"

End If

If AfterTxt = "DRILL" Then

AfterTxt = "キリ"

End If

TxtValue = BeforeTxt & TxtValue & AfterTxt

これまでに取得した寸法線(寸法値)の情報をもとに作成するテキストボックスの値を作成します。

①ではシンボルがあった場合に、シンボルの位置に「*」を入れる処理を行っています。
実際は同じシンボルを入力したいのですが、テキストボックスの値にシンボルを入れることがCATIA VBAでは不可能のようで、このような処理になっています。
ただ、シンボルが「R」の場合のみ「*」ではなく「R」を入力するようにしています。

②では関連テキストの値によって入力する内容を変換させています。
ここに条件分岐文を追加すれば、任意の文字列を別の文字列に変換させることができます。

ﾃｷｽﾄﾎﾞｯｸｽ作成

  '寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定
    Dim margin As Double
    margin = 3

  'ﾃｷｽﾄﾎﾞｯｸｽ作成
    Dim Txt As DrawingText
    Set Txt = DimView.Texts.Add(TxtValue, DimCoords(0), DimCoords(1) - margin)
    
    With Txt.TextProperties
        .AnchorPoint = catMiddleLeft    'ｱﾝｶｰﾎﾟｲﾝﾄ
        .FONTSIZE = 4.5                 'ﾌｫﾝﾄｻｲｽﾞ
        .FONTNAME = "KANJI"             'ﾌｫﾝﾄ
        .Color = -743277057             'ﾃｷｽﾄｶﾗｰ
    End With

'寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定

Dim margin As Double

margin = 3

'ﾃｷｽﾄﾎﾞｯｸｽ作成

Dim Txt As DrawingText

Set Txt = DimView.Texts.Add(TxtValue, DimCoords(0), DimCoords(1) - margin)

With Txt.TextProperties

.AnchorPoint = catMiddleLeft 'ｱﾝｶｰﾎﾟｲﾝﾄ

.FONTSIZE = 4.5 'ﾌｫﾝﾄｻｲｽﾞ

.FONTNAME = "KANJI" 'ﾌｫﾝﾄ

.Color = -743277057 'ﾃｷｽﾄｶﾗｰ

End With

これまでに寸法値の座標と値を取得したため、テキストボックスを作成します。

はじめに寸法値から何ミリ下の位置にテキストボックスを作成するかを指定するための「margin」という変数を作成しています。(現在は3mmとなっていますが、任意で微調整してください)

以上まででテキストボックスを作成する座標が指定できるようになったので、テキストボックスを作成します。テキストボックスは「DrawingTextsオブジェクト」の「Addメソッド」を使い以下のように書くことで作成できます。

Addメソッド(DrawingTextsオブジェクト)

Texts.Add TxtValue, CoordX, CoordY

TxtValueにはテキストボックスの値、
CoordXにはテキストボックスのX座標、
CoordYにはテキストボックスのY座標をそれぞれ入力します。

テキストボックスを作成したらテキストのプロパティを変換します。
今回のコードでは「アンカーポイントの変更」「フォントサイズの変更」「フォントの変更」「色の変更」を行っています。その他のプロパティを変更する場合は「DrawingTextPropertiesオブジェクト」の任意のプロパティを変更すればOKです。
　

位置ﾘﾝｸ作成

  '位置ﾘﾝｸ作成
    Txt.AssociativeElement = DrwDim

1 2	'位置ﾘﾝｸ作成 Txt.AssociativeElement = DrwDim

最後に作成したテキストボックスと寸法線に位置リンクを作成します。

位置リンクの作成は「DrawingTextオブジェクト」の「AssociativeElementプロパティ」を使って以下のように書きます。

AssociativeElementプロパティ

Txt.AssociativeElement = LinkObject

LinkObjectには位置リンクを付ける相手のオブジェクトを入力します。
現在のテキストボックスの位置と、現在の相手のオブジェクトの位置で位置リンクが作成されます。

まとめ

今回は「寸法線の値を取得しテキストを追記するマクロ」についての内容でした。

今回のサンプルコードでは寸法値に関する基本的な情報をかなり多く読み取っているので、他に寸法値のマクロを作成する際には役に立つ内容になっています。

コード自体はかなり長めになっていますが、やっていることは見た目以上にシンプルなのでコード解説を1つずつ理解していけばマクロ初心者の方でも十分に理解できる内容になっていると思います。
　

サンプルマクロ集に戻る
 目次へ戻る

CATIAマクロを本気で勉強するなら

Vb Scripting for Catia V5: How to Program Catia Macros

created by Rinker

CATIA V5: Macro Programming with Visual Basic Script

created by Rinker

McGraw-Hill Education

2020年11月2日2024年8月26日CATIA, CATIAマクロ

Posted by Lic

空のシートを一括で削除するマクロ｜CATIAマクロの作成方法

VBAでPython(pyファイル)を実行する方法2｜値を双方向で受け渡し合うには

寸法線の値を取得しテキストを追記するマクロ｜CATIAマクロの作成方法

マクロの機能

サンプルコード

コード解説

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義

ﾕｰｻﾞｰ選択

寸法線のﾋﾞｭｰを定義

寸法値の座標を取得

DrawingDimValueの取得

寸法値の精度のﾌｫｰﾏｯﾄを取得

画面に表示されている寸法値の取得

寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得

ｼﾝﾎﾞﾙの有無を確認

ﾃｷｽﾄﾎﾞｯｸｽに入力する値を修正

ﾃｷｽﾄﾎﾞｯｸｽ作成

位置ﾘﾝｸ作成

まとめ

icon-book CATIAマクロを本気で勉強するなら

　
DrawingDimValueの取得

CATIAマクロを本気で勉強するなら