Autocad VBA　入門    第２回

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回目は図形の編集（複写、鏡像、移動など）を扱います。

例１．コピー
![copy.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3373976/7f9a413d-4d77-4249-97cf-4a8c0b8d2296.png)

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	

例２．ミラー
![mirror.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3373976/755eb376-c055-4eb2-9cca-843e7d7b1d43.png)

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.　移動
![move.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3373976/c0a13933-c735-4280-95c5-951857c660f7.png)

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	

例４．オフセット
![offset.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3373976/0b1129a8-7692-445f-b5eb-101b761ab3b9.png)

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動画が　他社の講習会開催サイトなどに勝手に流用されています。あたかもそのサイトの運営者が作成したかの如く、さらに講習会の内容を説明したかの如く流用されていますがそのようなサイトとは全く無関係です。ご注意ください。