Autocad VBA 入門 のご紹介 第２回
CAD作業をVBAを使って自動化する技術をご紹介します。
本記事以外にも下記にて学習が可能です。ご利用ください。
また、Autocad 自動化の受注業務も行っています。
下記ホームページ下部のメールよりお気軽にご相談ください。
https://www.autotex.org/
(1)Youtube 動画で詳細に解説
https://www.youtube.com/watch?v=BSOfA0CdP4Y&list=PLTGhsY0lj6fYNFqS8rBjVbxjcqclj_5YD&index=10
(2)テキストの販売・・・下記ホームページよりご購入ください。
https://www.autotex.org/
注意：テキストは現在(2025年） 入門編と基礎編があります。
ご購入の領収書発行を行っています。
前回 第1回は簡単な2D図形の作図を扱いました。
今回、2回目は図形の編集（複写、鏡像、移動など）を扱います。
例１．コピー
Sub Example_Copy()
''''円を作成して、その円をコピー して、さらに、新しい円を移動させる。
'''注：移動させるのは元の円（赤色）ではない。
' 円オブジェクトを宣言
Dim circleObj As AcadCircle
'’円オブジェクト要素の宣言
Dim center(0 To 2) As Double
Dim radius As Double
'’円オブジェクト要素の設定
center(0) = 20#: center(1) = 0#: center(2) = 0#
radius = 5
''円オブジェクトを作成
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
circleObj.color = acRed
ZoomAll
'コピーオブジェクトの宣言
Dim copyCircleObj As AcadCircle
Set copyCircleObj = circleObj.Copy()
’移動ベクトルを構成するポイントを宣言
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
’移動ベクトルを構成するポイントを設定
point1(0) = 0: point1(1) = 0: point1(2) = 0
point2(0) =30: point2(1) = 0: point2(2) = 0
' 新しい円を移動
copyCircleObj.Move point1, point2
copyCircleObj.color = acGreen
ZoomExtents
End Sub
例２．ミラー
Sub Example_Mirror()
'ライトウエイトポリラインを作成してミラーする。
' ライトウエイトポリラインオブジェクトを宣言
Dim plineObj As AcadLWPolyline
' ライトウエイトポリライン要素の宣言
Dim points(0 To 11) As Double
' ライトウエイトポリライン要素の設定
points(0) = 1: points(1) = 1
points(2) = 1: points(3) = 2
points(4) = 2: points(5) = 2
points(6) = 3: points(7) = 2
points(8) = 4: points(9) = 4
points(10) = 4: points(11) = 1
' ライトウエイトポリラインの作成
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True ’ライトウエイトポリラインを閉じる
plineObj.color = acRed
ZoomAll
'ミラーオブジェクトの宣言
Dim mirrorObj As AcadLWPolyline
' 対称軸を決める2点の宣言
Dim point1(0 To 2) As Double ’対称軸の 1 点目の 3D WCS 座標
Dim point2(0 To 2) As Double ’対称軸の 2点目の 3D WCS 座標
' 対称軸を決める2点を設定
point1(0) = 0: point1(1) = 4.25: point1(2) = 0
point2(0) = 4: point2(1) = 4.25: point2(2) = 0
' ポリラインをミラー（戻り値 ObjectよりDim宣言が必要）
Set mirrorObj = plineObj.Mirror (point1, point2)
’’’注：リージョンをミラーする場合はEntityで宣言すること！
mirrorObj.color = acGreen
ZoomExtents
End Sub
例3. 移動
Sub Example_Move()
''''円を作成して、その円をコピー して、さらに、新しい円を移動させる。
''注：移動させるのは元の円（赤色）ではない。
' 円オブジェクトを宣言
Dim circleObj As AcadCircle
'’円オブジェクト要素の宣言
Dim center(0 To 2) As Double
Dim radius As Double
'’円オブジェクト要素の設定
center(0) = 20#: center(1) = 0#: center(2) = 0#
radius = 5
''円オブジェクトを作成
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
circleObj.color = acRed
ZoomAll
'コピーオブジェクトの宣言
Dim copyCircleObj As AcadCircle
Set copyCircleObj = circleObj.Copy()
’’’’注意：移動が分かるように元の円をコピーしています。
’移動ベクトルを構成するポイントを宣言
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
’移動ベクトルを構成するポイントを設定
point1(0) = 0: point1(1) = 0: point1(2) = 0
point2(0) =30: point2(1) = 0: point2(2) = 0
' 新しい円を移動
copyCircleObj.Move point1, point2
copyCircleObj.color = acGreen
ZoomExtents
End Sub
例４．オフセット
Sub Example_Offset()
'ライトウエイトポリライン（赤色）を作成して、オフセットします。
' ライトウエイトポリラインオブジェクトを宣言
Dim plineObj As AcadLWPolyline
' ライトウエイトポリライン要素の宣言
Dim points(0 To 11) As Double
' ライトウエイトポリライン要素の設定
points(0) = 10: points(1) =10
points(2) = 10: points(3) = 20
points(4) = 20: points(5) = 20
points(6) = 30: points(7) = 20
points(8) = 40: points(9) = 40
points(10) = 40: points(11) = 10
' ライトウエイトポリラインの作成
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True ’ライトウエイトポリラインを閉じる
plineObj.color = acRed
ZoomAll
'オフセットオブジェクト宣言
Dim offsetObj As Variant '''注：バリアント型（オブジェクト配列）である。
’ライトウエイトポリラインをオフセット
offsetObj = plineObj.offset (2) '''正数・・・内側オフセット、負数・・・外側オフセット
offsetObj(0).color = acGreen '''配列(0)が必要である。
ZoomExtents
End Sub
次回は 編集の2回目 回転、尺度変更、変換マトリクス、円形状配列、矩形状配列を扱います。
以後 独特メソッドとして ブール演算、分解、頂点追加、ハッチングなどを扱います。
また Youtubeに 動画をUPしていますのでご覧ください。
注意：AutoteXが作成したYoutube動画が 他社の講習会開催サイトなどに勝手に流用されています。あたかもそのサイトの運営者が作成したかの如く、さらに講習会の内容を説明したかの如く流用されていますがそのようなサイトとは全く無関係です。ご注意ください。