寸法線の値を取得しテキストを追記するマクロ|CATIAマクロの作成方法
今回の記事はマクロ案募集でいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ: ドラフティング
マクロ案:
CATIA Drawingの“寸法コマンドで作図された寸法線の下に、
テキストエディターで下図のようなオブジェクト”をマクロで作図することは可能でしょうか?
(テキストには、寸法線に対して、位置リンクも付加したいです。)
お問い合わせの内容からすると、「複数の寸法線に対して一括でテキストボックスを作成する」という内容のようですが、ここではコード解説のし易さから「選択された1つの寸法線に対してテキストボックスを作成する」という内容になっています。
コードの内容さえ理解できれば、ループ文を使って一括で作成するコードにすぐに書き換えることができるので、まずはコードを理解するところから始めることをオススメします。
マクロの機能
今回作成したマクロは上画像の通り寸法線の下にテキストボックスを作成するマクロです。
(※ 画像クリックで拡大)
具体的な機能は以下のとおりです。
・テキストボックスの値は画面に表示されている寸法線と同じ値
・シンボルの部分は「*」に置き換える
・テキストボックスには寸法線との位置リンクを作成する
シンボルの部分を「*」に置き換えるのは、VBAでテキストの値にシンボルを追加することができないためです。(実際はできるのかもしれませんが)
サンプルコード
マクロのコードは以下のとおりです。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 |
コード解説
アクティブドキュメント確認
1 2 3 4 5 |
'アクティブドキュメント確認 If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "CATDrawingのみ対応のマクロです。" Exit Sub End If |
まず、はじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
アクティブドキュメント/Selectionの定義
1 2 3 4 5 6 7 8 |
'アクティブドキュメント定義 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メソッド」を利用できるようにするためです。
ユーザー選択
1 2 3 4 5 6 7 8 9 10 11 12 13 |
'ユーザー選択 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」に格納します。
寸法線のビューを定義
1 2 3 |
'寸法線のビューを定義 Dim DimView As DrawingView Set DimView = DrwDim.Parent.Parent |
ユーザーが選択した寸法線があるビューを取得します。
「DrawingDimension」の親のオブジェクトは「DrawingDimensions」、
「DrawingDimensions」の親のオブジェクトは「DrawingView」です。
つまり「DrwDim」の親の親が「DrwDim」があるビューを表します。
よって「DrwDim.Parent.Parent」=「DrwDimがあるビュー」を表します。
寸法値の座標を取得
1 2 3 |
'寸法値の座標を取得 Dim DimCoords(1) Call DrwDim.GetBoundaryBox(DimCoords) |
寸法線の寸法値部分の座標を取得します。
寸法値の座標を取得するには「DrawingDimensionオブジェクト」の「GetBoundaryBoxメソッド」を使います。このメソッドでは寸法値の4隅の座標を取得することができます。
ここでは寸法値の左下のみの座標を取得しています。
ちなみに配列の要素数を増やすとそれぞれ以下の通りの座標が取得できます。
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の取得
1 2 3 |
'DrawingDimValueの取得 Dim DimVal As DrawingDimValue Set DimVal = DrwDim.GetValue |
「DrawingDimValueオブジェクト」を取得します。
このオブジェクトのプロパティ/メソッドを使うことで、寸法値に関する操作を行うことが可能になります。以降では「寸法値の取得」「寸法値のフォーマットの取得」「関連テキストの取得」「シンボルの取得」の際にこのオブジェクトを使用します。
寸法値の精度のフォーマットを取得
1 2 3 4 5 6 7 |
'寸法値の精度のフォーマットを取得 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」に丸められてしまうので注意)
画面に表示されている寸法値の取得
1 2 3 4 |
'画面に表示されている寸法値の取得 Dim TxtValue As String TxtValue = Format(DimVal.Value, DimValPreFormat) TxtValue = Trim(TxtValue) |
画面上で表示されている寸法値を取得します。
寸法値は「DrawingDimValueオブジェクト」の「Valueプロパティ」より取得できます。
ただ先にもいっている通り、これで取得できる値は非常に細かいものとなってしまいます。
そこで上記で作成した寸法値の精度のフォーマット(0.0や0.00)とFormat関数を使い、寸法値を画面上に表示されている値と同じになるように丸めます。
寸法テキスト(関連テキスト)取得
1 2 3 4 5 |
'寸法テキスト(関連テキスト)取得 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 → 関連テキスト下側の値
この時、変数の代わりに「””」と入力することでその部分の取得を無視することもできます。
シンボルの有無を確認
1 2 3 4 5 |
'シンボルの有無を確認 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 → 右側のシンボル
テキストボックスに入力する値を修正
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
'テキストボックスに入力する値を修正 '① シンボル部分に「*」を追加 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」を入力するようにしています。
②では関連テキストの値によって入力する内容を変換させています。
ここに条件分岐文を追加すれば、任意の文字列を別の文字列に変換させることができます。
テキストボックス作成
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
'寸法値とテキストボックスの余白(隙間)指定 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です。
位置リンク作成
1 2 |
'位置リンク作成 Txt.AssociativeElement = DrwDim |
最後に作成したテキストボックスと寸法線に位置リンクを作成します。
位置リンクの作成は「DrawingTextオブジェクト」の「AssociativeElementプロパティ」を使って以下のように書きます。
Txt.AssociativeElement = LinkObject
LinkObjectには位置リンクを付ける相手のオブジェクトを入力します。
現在のテキストボックスの位置と、現在の相手のオブジェクトの位置で位置リンクが作成されます。
まとめ
今回は「寸法線の値を取得しテキストを追記するマクロ」についての内容でした。
今回のサンプルコードでは寸法値に関する基本的な情報をかなり多く読み取っているので、他に寸法値のマクロを作成する際には役に立つ内容になっています。
コード自体はかなり長めになっていますが、やっていることは見た目以上にシンプルなのでコード解説を1つずつ理解していけばマクロ初心者の方でも十分に理解できる内容になっていると思います。