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

今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ: ドラフティング
　
マクロ案:
CATIA Drawingで “R寸法の寸法値の横に特定の文字を『テキストエディター』で併記”、
“寸法値の下に特定の文字の『テキストエディター』の文字を併記する“ことは
マクロで行うことは可能でしょうか？
（テキストには、寸法線に対して、位置リンクと方向リンクも付加したいです。）

マクロの内容としては前回作成した「寸法線の値を取得しテキストを追記するマクロ」に角度機能が追加しただけの内容です。

内容としては角度機能が追加されただけですが、処理内容としては少し難しいものとなっています。
サイン、コサインなどの三角関数、度とラジアンの変換などの高校数学をある程度理解していないとついていけない内容です。

また、VBAでは位置リンクの作成は可能ですが方向リンクを作成することができないようです。
そこでここでは、現在の寸法線に対して同じ角度のテキストボックスを作成する処理を行います。
方向リンクは付けていないので、寸法線を移動しても角度は追従しないので注意して下さい。

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

マクロの機能

今回作成したマクロは上画像の通り寸法線の下にテキストボックスを作成するマクロです。
前回のマクロに角度機能を追加しただけのマクロです。

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

マクロの機能まとめ・選択した寸法線の下にテキストボックスを作成
・テキストボックスの値は画面に表示されている寸法線と同じ値
・テキストボックスには寸法線との位置リンクを作成する
・テキストボックスは寸法線と同じ角度にする ← NEW

前回は寸法線のシンボル(ΦやR)の代わりに「*」を付与する機能がありましたが、今回はシンボルが「R」の場合のみ付与し、それ以外の場合は無視するといった内容になっています。

サンプルコード

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

Sub CATMainX()

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
    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(3)
    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)
    
  '寸法線の角度取得
    Dim DimAngle As Double
    Dim pai As Double
    
    pai = 4 * Atn(1) '3.14159265...
    
    If DimCoords(3) = DimCoords(1) Then
        DimAngle = 0
    ElseIf DimCoords(2) = DimCoords(0) Then
        DimAngle = 90
    Else
        DimAngle = Atn((DimCoords(3) - DimCoords(1)) / (DimCoords(2) - DimCoords(0)))
        DimAngle = DimAngle * 180 / pai
    End If

    If BeforeSym = "R" Then
        TxtValue = "R" & TxtValue
    End If
  
    TxtValue = BeforeTxt & TxtValue & AfterTxt
    
    
'****************************************************
'                  ﾃｷｽﾄﾎﾞｯｸｽ作成
'****************************************************
    
  '寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定
    Dim margin As Double
    Dim marginX As Double
    Dim marginY As Double
    Dim tmpDimAngle As Double
    
    margin = 3.5
    
    If DimAngle = 0 Then
        marginX = 0
        marginY = margin
    ElseIf DimAngle = 90 Then
        marginX = margin
        marginY = 0
    ElseIf DimAngle > 0 Then
        tmpDimAngle = (90 - Abs(DimAngle)) * pai / 180
        marginX = margin * Cos(tmpDimAngle)
        marginY = margin * Sin(tmpDimAngle)
    ElseIf DimAngle < 0 Then
        tmpDimAngle = Abs(DimAngle) * pai / 180
        marginX = -1 * margin * Sin(tmpDimAngle)
        marginY = margin * Cos(tmpDimAngle)
    End If

  'ﾃｷｽﾄﾎﾞｯｸｽ作成
    Dim txt As DrawingText
    Set txt = DimView.Texts.Add(TxtValue, DimCoords(0) + marginX, DimCoords(1) - marginY)
    
    With txt.TextProperties
        .AnchorPoint = catMiddleLeft    'ｱﾝｶｰﾎﾟｲﾝﾄ
        .FONTSIZE = 3.5                 'ﾌｫﾝﾄｻｲｽﾞ
        .FONTNAME = "KANJI"             'ﾌｫﾝﾄ
        .Color = -743277057             'ﾃｷｽﾄｶﾗｰ
    End With
    
  'ﾃｷｽﾄﾎﾞｯｸｽの角度変更
    txt.Angle = DimAngle
  
  '位置ﾘﾝｸ作成
    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

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

Sub CATMainX()

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

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(3)

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)

'寸法線の角度取得

Dim DimAngle As Double

Dim pai As Double

pai = 4 * Atn(1) '3.14159265...

If DimCoords(3) = DimCoords(1) Then

DimAngle = 0

ElseIf DimCoords(2) = DimCoords(0) Then

DimAngle = 90

Else

DimAngle = Atn((DimCoords(3) - DimCoords(1)) / (DimCoords(2) - DimCoords(0)))

DimAngle = DimAngle * 180 / pai

End If

If BeforeSym = "R" Then

TxtValue = "R" & TxtValue

End If

TxtValue = BeforeTxt & TxtValue & AfterTxt

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

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

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

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

Dim margin As Double

Dim marginX As Double

Dim marginY As Double

Dim tmpDimAngle As Double

margin = 3.5

If DimAngle = 0 Then

marginX = 0

marginY = margin

ElseIf DimAngle = 90 Then

marginX = margin

marginY = 0

ElseIf DimAngle > 0 Then

tmpDimAngle = (90 - Abs(DimAngle)) * pai / 180

marginX = margin * Cos(tmpDimAngle)

marginY = margin * Sin(tmpDimAngle)

ElseIf DimAngle < 0 Then

tmpDimAngle = Abs(DimAngle) * pai / 180

marginX = -1 * margin * Sin(tmpDimAngle)

marginY = margin * Cos(tmpDimAngle)

End If

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

Dim txt As DrawingText

Set txt = DimView.Texts.Add(TxtValue, DimCoords(0) + marginX, DimCoords(1) - marginY)

With txt.TextProperties

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

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

.FONTNAME = "KANJI" 'ﾌｫﾝﾄ

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

End With

'ﾃｷｽﾄﾎﾞｯｸｽの角度変更

txt.Angle = DimAngle

'位置ﾘﾝｸ作成

txt.AssociativeElement = DrwDim

End Sub

コード解説

基本的な部分は前回作成した「寸法線の値を取得しテキストを追記するマクロ」と同じです。
そのためここでは前回はなった、「角度」と「余白(隙間)」部分のコードを解説していきます。

円周率やサイン、コサインなどの三角関数を扱うので高校数学を思い出しながら読み進めて下さい。

寸法線の角度取得

  '寸法線の角度取得
    Dim DimAngle As Double
    Dim pai As Double
    
    pai = 4 * Atn(1) '3.14159265...
    
    If DimCoords(3) = DimCoords(1) Then
        DimAngle = 0
    ElseIf DimCoords(2) = DimCoords(0) Then
        DimAngle = 90
    Else
        DimAngle = Atn((DimCoords(3) - DimCoords(1)) / (DimCoords(2) - DimCoords(0)))
        DimAngle = DimAngle * 180 / pai
    End If

'寸法線の角度取得

Dim DimAngle As Double

Dim pai As Double

pai = 4 * Atn(1) '3.14159265...

If DimCoords(3) = DimCoords(1) Then

DimAngle = 0

ElseIf DimCoords(2) = DimCoords(0) Then

DimAngle = 90

Else

DimAngle = Atn((DimCoords(3) - DimCoords(1)) / (DimCoords(2) - DimCoords(0)))

DimAngle = DimAngle * 180 / pai

End If

「DrawingDimensionオブジェクト」の「GetBoundaryBoxメソッド」から、寸法値部分の4隅の座標が求められます。(コードでいうとDimCoordsに格納されている値)

このうち寸法値の左下と右下の座標から、寸法線の角度を求めていきます。

2点の座標から角度を求めるにはアークタンジェント(逆三角関数)を使います。
VBAには指定した数字のアークタンジェントを返す「Atn関数」があるのでこの関数を使って角度を求めていきます。

Atn関数で点1(x1,y1)と点2(x2,y2)の角度を求めるには以下のように書きます。

Atn関数で角度を求める(ラジアン)

Dim Angle As Double
Angle = Atn((y2 – y1) / (x2 – x1))

ここで注意しないといけないのでは、求めた角度が「ラジアン」であるという点です。ここでは「ラジアン」ではなく「度」として角度を取得しておきたいので、求めたラジアンに「180/円周率」をかける必要があります。

そこでAtn関数を使って円周率(3.1415…)も求めておく必要があります。
以下のように書くことで円周率を求めることができます。(公式なので丸暗記でOKです)

Atn関数で円周率を求める

Dim pai As Double
pai = 4 * Atn(1)

　
以上の内容により寸法線の角度を求めることができます。
このとき寸法線が90度、0度の時はAtn関数でエラーが発生するので条件分岐で処理を分けておく必要があるので注意しましょう。
　

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

  '寸法値とﾃｷｽﾄﾎﾞｯｸｽの余白(隙間)指定
    Dim margin As Double
    Dim marginX As Double
    Dim marginY As Double
    Dim tmpDimAngle As Double
    
    margin = 3.5
    
    If DimAngle = 0 Then
        marginX = 0
        marginY = margin
    ElseIf DimAngle = 90 Then
        marginX = margin
        marginY = 0
    ElseIf DimAngle > 0 Then
        tmpDimAngle = (90 - Abs(DimAngle)) * pai / 180
        marginX = margin * Cos(tmpDimAngle)
        marginY = margin * Sin(tmpDimAngle)
    ElseIf DimAngle < 0 Then
        tmpDimAngle = Abs(DimAngle) * pai / 180
        marginX = -1 * margin * Sin(tmpDimAngle)
        marginY = margin * Cos(tmpDimAngle)
    End If