AutoCAD 2000 ActiveX によるカスタマイズ　�B

ＡｃｔｉｖｅＸで何ができるか？と聞かれると。AutoCADの持つオブジェクトを外部のソフトから操作できる。と言った答えになるかと思います。でも、やっぱり何のこっちゃ？て感じだと思います。で、もう少し解り易く、具体的に説明します。

これはAutoCADのオブジェクトプロパティ管理でAddLineサンプルで描いた線の情報を見ています。この線オブジェクトは、始点、終点座標、画層、線種などの情報を持っています。このオブジェクトプロパティ管理で始点座標を変更すると、結果はすぐに線に反映されます。
ＡｃｔｉｖｅＸでAutoCADの持つオブジェクトを外部のソフトから操作するとは、例えばVBでこの線の始点プロパティを変更すると言った事です。

線のオブジェクト名は AcadLine です。
Dim lineObj As AcadLine　と言った形で宣言し
線を描くのは、AddLine メソッドを使用します。

作図されている線の編集またはクエリーを行うには、次に示すメソッドとプロパティを使用します。

メソッド	プロパティ
ArrayPolar	Angle
ArrayRectangular	Application
Copy	Color
Delete	Document
GetBoundingBox	Delta
GetExtensionDictionary	EndPoint
GetXData	Handle
Highlight	HasExtensionDictionary
IntersectWith	Hyperlinks
Mirror	Layer
Mirror3D	Length
Move	Linetype
Offset	LinetypeScale
Rotate	Lineweight
Rotate3D	Normal
ScaleEntity	ObjectID
SetXData	OwnerID
TransformBy	PlotStyleName
Update	StartPoint
Thickness
Visible

これらのメソッドとプロパティを使ってAutoCAD上と同じようにオブジェクトを操作できるのです。
例えば、AddLineサンプルの線の色を変えるのは「Color」プロパティを使います。

lineObj.Color = acRed
※もちろんAddLineで線を描いた後に...

AddLineサンプルをチョット変更し、「Copy」「Move」メソッドと「Color」プロパティを使って複数の色の線を描いてみました。

AutoCAD上で、こんな感じになれば成功です。

ActiveXサンプルソース

' ActiveX Sample for AutoCAD 2000 ' '　　　by akira nishio 2000.1.2 Option Explicit Public AcadApp As AcadApplication Public AcadDoc As AcadDocument Public Sub Main() '**********アプリケーションの初期化********** On Error Resume Next 'AutoCAD 2000アプリケーションオブジェクトを取得 Set AcadApp = GetObject(, "AutoCAD.Application.15") 'AutoCAD 2000アプリケーションオブジェクト取得に失敗した時 If Err Then 　　'AutoCAD 2000を起動 　　Set AcadApp = CreateObject("AutoCAD.Application.15") 　　'エラーオブジェクトをクリア 　　Err.Clear End If 'AutoCADを表示 AcadApp.Visible = True Set AcadDoc = AcadApp.ActiveDocument '********** AddLineサンプルより *********** ' This example adds a line in model space Dim lineObj As AcadLine Dim startPoint(0 To 2) As Double Dim endPoint(0 To 2) As Double ' Define the start and end points for the line startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0# endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0# ' Create the line in model space Set lineObj = AcadDoc.ModelSpace.AddLine(startPoint, endPoint) '********** ActiveXサンプル *********** Dim NewLineObj(10) As AcadLine Dim i As Integer 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) = 0: point2(1) = 0: point2(2) = 0 '移動ベクトル終点 For i = 1 To 10 　　'ラインオブジェクトのコピー 　　Set NewLineObj(i) = lineObj.Copy 　　'色を変える 　　NewLineObj(i).Color = i * 10 　　 　　point2(0) = i 　　'移動 　　NewLineObj(i).Move point1, point2 Next i Update ZoomExtents End Sub