寸法線の値を取得しテキストを追記するマクロ｜CATIAマクロの作成方法
今回の記事はマクロ案募集でいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ: ドラフティング
マクロ案:
CATIA Drawingの“寸法コマンドで作図された寸法線の下に、
テキストエディターで下図のようなオブジェクト”をマクロで作図することは可能でしょうか?
(テキストには、寸法線に対して、位置リンクも付加したいです。)
お問い合わせの内容からすると、「複数の寸法線に対して一括でテキストボックスを作成する」という内容のようですが、ここではコード解説のし易さから「選択された1つの寸法線に対してテキストボックスを作成する」という内容になっています。
コードの内容さえ理解できれば、ループ文を使って一括で作成するコードにすぐに書き換えることができるので、まずはコードを理解するところから始めることをオススメします。
マクロの機能
今回作成したマクロは上画像の通り寸法線の下にテキストボックスを作成するマクロです。
(※ 画像クリックで拡大)
具体的な機能は以下のとおりです。
・テキストボックスの値は画面に表示されている寸法線と同じ値
・シンボルの部分は「*」に置き換える
・テキストボックスには寸法線との位置リンクを作成する
シンボルの部分を「*」に置き換えるのは、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
コード解説
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
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
アクティブドキュメントと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
「SelectElement2メソッド」を使ってユーザーに寸法線を選択させます。
(SelectElement2の詳しい使い方は上記リンクページを参照下さい)
このとき選択された寸法線は変数「DrwDim」に格納します。
寸法線のﾋﾞｭｰを定義
'寸法線のﾋﾞｭｰを定義
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)
寸法線の寸法値部分の座標を取得します。
寸法値の座標を取得するには「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 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)
画面上で表示されている寸法値を取得します。
寸法値は「DrawingDimValueオブジェクト」の「Valueプロパティ」より取得できます。
ただ先にもいっている通り、これで取得できる値は非常に細かいものとなってしまいます。
そこで上記で作成した寸法値の精度のフォーマット(0.0や0.00)とFormat関数を使い、寸法値を画面上に表示されている値と同じになるように丸めます。
寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得
'寸法ﾃｷｽﾄ(関連ﾃｷｽﾄ)取得
Dim BeforeTxt As String
Dim AfterTxt As String
Call DimVal.GetBaultText(1, BeforeTxt, AfterTxt, "", "")
関連テキストの取得を行います。
関連テキストとは寸法値の上下左右に入力されたテキストのことです。
ここでは上下の関連テキストは無視し、左右の関連テキストのみを取得していきます。
関連テキストを取得するには「DrawingDimValueオブジェクト」の「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)
寸法値のシンボル(「Φ」や「±」など)を取得します。
シンボルを取得するには「DrawingDimValueオブジェクト」の「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
これまでに取得した寸法線(寸法値)の情報をもとに作成するテキストボックスの値を作成します。
①ではシンボルがあった場合に、シンボルの位置に「*」を入れる処理を行っています。
実際は同じシンボルを入力したいのですが、テキストボックスの値にシンボルを入れることが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
これまでに寸法値の座標と値を取得したため、テキストボックスを作成します。
はじめに寸法値から何ミリ下の位置にテキストボックスを作成するかを指定するための「margin」という変数を作成しています。(現在は3mmとなっていますが、任意で微調整してください)
以上まででテキストボックスを作成する座標が指定できるようになったので、テキストボックスを作成します。テキストボックスは「DrawingTextsオブジェクト」の「Addメソッド」を使い以下のように書くことで作成できます。
Texts.Add TxtValue, CoordX, CoordY
TxtValueにはテキストボックスの値、
CoordXにはテキストボックスのX座標、
CoordYにはテキストボックスのY座標をそれぞれ入力します。
テキストボックスを作成したらテキストのプロパティを変換します。
今回のコードでは「アンカーポイントの変更」「フォントサイズの変更」「フォントの変更」「色の変更」を行っています。その他のプロパティを変更する場合は「DrawingTextPropertiesオブジェクト」の任意のプロパティを変更すればOKです。
位置ﾘﾝｸ作成
'位置ﾘﾝｸ作成
Txt.AssociativeElement = DrwDim
最後に作成したテキストボックスと寸法線に位置リンクを作成します。
位置リンクの作成は「DrawingTextオブジェクト」の「AssociativeElementプロパティ」を使って以下のように書きます。
Txt.AssociativeElement = LinkObject
LinkObjectには位置リンクを付ける相手のオブジェクトを入力します。
現在のテキストボックスの位置と、現在の相手のオブジェクトの位置で位置リンクが作成されます。
まとめ
今回は「寸法線の値を取得しテキストを追記するマクロ」についての内容でした。
今回のサンプルコードでは寸法値に関する基本的な情報をかなり多く読み取っているので、他に寸法値のマクロを作成する際には役に立つ内容になっています。
コード自体はかなり長めになっていますが、やっていることは見た目以上にシンプルなのでコード解説を1つずつ理解していけばマクロ初心者の方でも十分に理解できる内容になっていると思います。
CATIAマクロを本気で勉強するなら
