EXCEL VBAを使ってAutoCADの水平寸法線、垂直寸法線を追加する方法

EXCEL×AutoCAD

はじめに

こんにちは。今回はエクセルを使って、AutoCADに水平寸法線、垂直寸法線を記入する手順を解説します。また、後半では簡単に使用できるようにFunctionプロシージャも用意しました。ぜひご活用ください。

水平寸法線を追加するサンプルコード

それでは、エクセルに入力した値を使って平行寸法線を描くサンプルコードを紹介します。
まずは下のようなエクセルシートを準備します。

A2セル~I2セルの並びが入力セルです。
K2は描いた寸法線の計測値を取得する用のセルです。入力は不要です。
L2は描いた寸法線のハンドル値を取得する用のセルです。入力は不要です。

VBAのコードは以下のようになります。

VB
Sub DrawHorizontalDimInAutoCAD()
  Dim acadApp As Object 'AutoCADアプリケーションオブジェクトを宣言
  Dim acadDoc As Object 'AutoCADドキュメントオブジェクトを宣言
  Dim dimLine As Object '寸法線オブジェクトを宣言
  Dim startPoint(2) As Double '寸法計測点の座標格納用
  Dim endPoint(2) As Double '寸法計測点の座標格納用
  Dim dimPoint(2) As Double '寸法線のテキスト位置の座標格納用
  Dim angle As Double '寸法の計測角度
  
  'AutoCADが起動していなければ起動し、すでに開いていたら取得する。
  On Error Resume Next
  Set acadApp = GetObject(,"AutoCAD.Application")
  If acadApp Is Nothing Then
    Set acadApp = CreateObject("AutoCAD.Application")
  End If
  On Error GoTo 0
  
  'AutoCADを表示
  acadApp.Visible = True
  
  'AutoCADドキュメントが開いてなければ新規作成し、開いていれば取得する。
  On Error Resume Next
  Set acadDoc = acadApp.ActiveDocument
  If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
  End If
  On Error GoTo 0 
  
  '始点を設定
  startPoint(0) = Cells(2,1) 'X座標
  startPoint(1) = Cells(2,2) 'Y座標
  startPoint(2) = Cells(2,3) 'Z座標
  
  '終点を設定
  endPoint(0) = Cells(2,4) 'X座標
  endPoint(1) = Cells(2,5) 'Y座標
  endPoint(2) = Cells(2,6) 'Z座標  
  
  '寸法のテキスト位置を設定
  dimPoint(0) = Cells(2,7) 'X座標
  dimPoint(1) = Cells(2,8) 'Y座標
  dimPoint(2) = Cells(2,9) 'Z座標    
  
  '計測角度の入力(水平寸法の場合)
  angle = 0 * 3.141592 / 180
  
  '寸法線の記入
  Set dimLine = acadDoc.ModelSpace.AddDimRotated(startPoint, endPoint, dimPoint, angle)
  
  '寸法距離の取得
  Cells(2, 10) = dimLine.Measurement
  
  'ハンドルの取得
  Cells(2,11) = dimLine.Handle
  
  'メッセージを表示
  MsgBox ”寸法線を記入しました!”
End Sub
  
  • 垂直寸法を作成したい場合は、45行目を「angle = 90 * 3.141592 / 180」に変更してください。

EXCELでのVBAの準備

次に、簡単に平行寸法線を追加できるFunctionプロシージャを紹介しますが、その前に準備が必要です。AutoCADのオブジェクトライブラリを参照設定を行います。下記操作を行ってください。

  • VBAエディタのメニューから「ツール」→「参照設定」を選択します。
  • リストから「AutoCAD Type Library」または「AutoCAD Object Libraly」を選択し、チェックを入れて「OK」をクリックします。
    (※Verにより多少名称が変わるかもしれません。「AutoCAD 2021 Type Library」など。)

平行寸法線を追加するVBA Functionプロシージャ

コードをFunctionプロシージャとして作成すれば、もっと容易に大量の平行寸法線を描くことが出来るようになります。ここでは、その方法を記述します。

まず、EXCEL VBAの標準モジュールの中に下記コードをこのまま記述しましょう。

VB
Public acadApp As AcadApplication       'AutoCADのアプリケーションドキュメントを保持する変数
Public acadDoc As AutoCAD.AcadDocument  'AutoCADのドキュメントオブジェクトを保持する変数

Function DrawDimInAutoCAD(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double, x3 As Double, y3 As Double, z3 As Double, a1 As Double) As String
  'AutoCADに寸法線を描画する関数
  '引数は最初から順に
  '始点のX座標、Y座標、Z座標、終点のX座標、Y座標、Z座標、寸法線のテキストのX座標、Y座標、Z座標、角度
  '水平寸法線なら角度は0、垂直寸法線なら角度は90にする。
  '戻り値は描画した寸法線のハンドル
  
  Dim dimLine As Object '寸法線オブジェクトを保持する変数
  
  Dim startPoint(2) As Double '始点の座標を保持する配列
  Dim endPoint(2) As Double '終点の座標を保持する配列
  Dim dimPoint(2) As Double '寸法線のテキストの座標を保持する配列
  Dim angle As Double  '寸法の計測角度
  
  '始点の座標を設定
  startPoint(0) = x1
  startPoint(1) = y1
  startPoint(2) = z1
  
  '終点の座標を設定
  endPoint(0) = x2
  endPoint(1) = y2
  endPoint(2) = z2
  
  '寸法線テキストの座標を設定
  dimPoint(0) = x3
  dimPoint(1) = y3
  dimPoint(2) = z3  
  
  '計測角度の入力
  angle = a1 * 3.141592 / 180
  
  '寸法線の記入
  Set dimLine = acadDoc.ModelSpace.AddDimRotated(startPoint, endPoint, dimPoint, angle)
  
  '追加した線分のハンドルを返す
  DrawDimInAutoCAD = dimLine.Handle
  
End Function

これで寸法線を描くときはDrawDimInAutoCAD(x1,y1,z1,x2,y2,z2,x3,y3,z3,a1)を呼び出すだけで簡単に使えます。

例えば、次のようなシートを準備します。

そしてメインのプロシージャのサンプルを記述します。このサンプルはAutoCADを開いた状態で実行してください。アクティブになっている図面に線分を描きます。

VB
public Sub main()
  On Error GoTo OUT1 'エラーハンドリング:AutoCADが起動していないとき
  Set acadApp =GetObject(,"AutoCAD.Application") '既存のAutoCADアプリケーションの取得
  
  On Error GoTo OUT2 'エラーハンドリング:AutoCADのファイルが開かれてない場合
  Set acadDoc = acadApp.ActiveDocument 'アクティブなAutoCADドキュメントを取得
  
  On Error GoTo 0 'エラーハンドリングをリセット
  
  'AutoCADに寸法線を描画し、そのハンドルをExcelに書き込む
  Cells(2,11) = DrawDimInAutoCAD(Cells(2,1), Cells(2,2), Cells(2,3), Cells(2,4), Cells(2,5), Cells(2,6), Cells(2,7), Cells(2,8), Cells(2,9), Cells(2,10))
  Cells(3,11) = DrawDimInAutoCAD(Cells(3,1), Cells(3,2), Cells(3,3), Cells(3,4), Cells(3,5), Cells(3,6), Cells(3,7), Cells(3,8), Cells(3,9), Cells(3,10))
  Exit Sub
OUT1:
  MsgBox "AutoCADを起動してください"
  Exit Sub
OUT2:
 MsgBox "AutoCADのファイルを開いてください"
End Sub

11~12行目がFunctionプロシージャを呼び出しているところです。サンプルのためひとつひとつ記述してますが、For文など使用すれば大量に線分を描くことが出来るでしょう。

もちろん、セルから値を読み込まなくても下記のように使用できます。

VB
  Cells(2,10) = DrawAlDimInAutoCAD(0, 0, 0, 1000, 1000, 0, 500, -500, 0, 0) '(0,0,0)(1000,1000,0)に水平寸法線を描く

線分を描きたいけれどハンドルは不要という場合は、下記のように適当にdummyなどの変数を用意して対応すればよいでしょう。

VB
 dummy = DrawAlDimInAutoCAD(0, 0, 0, 1000, 1000, 0, -500, 500, 0, 90) '(0,0,0)(1000,1000,0)に垂直寸法線を描く

おわりに

今回の記事では、Excel VBAを使用してAutoCADに水平寸法線、垂直寸法線を描く方法を紹介しました。
VBAを活用することで、AutoCADでの作業を自動化し、設計の効率をさらに高めることが出来ます。

寸法線「僕が正確にしてあげるよ」

コメント

タイトルとURLをコピーしました