OLEオートメーションサンプルコード

作成日 : 2003-08-13

文書番号 : S3-0004

イッツ超キャド3

以下のサンプルコードは弊社で、オートメーションの検証用に用いているコードをそのまま公開しているものです。以下のサンプルコードは、動作をすべて保証するものでもありません。以下のコードを用いて生じた損害や弊害につきましては責任は負いかねますので、個人の責任でお願いします。

サンプルコード

Dim Count As Integer
Dim I As Integer
Dim myDraw As ITsCAD.drawing
Dim myLayer As ITsCAD.Layer
Dim myCoor As ITsCAD.Coordinate
Dim myEntity As ITsCAD.Entity

Set myDraw = New ITsCAD.drawing ' キャド起動

myDraw.Application.Visible = True ' キャド表示

Count = myDraw.GetCoordinateCount
For I = Count To 2 Step -1
Set myCoor = myDraw.GetCoordinate(I)
myDraw.DeleteCoordinate myCoor '余分な座標系を削除
Next

Count = myDraw.GetLayerCount
For I = Count To 3 Step -1
Set myLayer = myDraw.GetLayer(I)
myDraw.DeleteLayer myLayer ' 余分なレイヤーを削除
Next

Set myCoor = myDraw.AddCoordinate("新規", 0.1, 0.1, 0, 0, 0, 0, 0, False) ' 座標系を追加
Set myLayer = myDraw.AddLayer("新規") ' レイヤーを追加

Set myEntity = myDraw.DBAddLine(0, 0, 10, 10, myLayer, myCoor) ' 線を描画
myDraw.DBAddCircle 10, 0, 10, myLayer, myCoor ' 円を描画
myDraw.DBAddArc 20, 0, 10, 0, 3.141592, myLayer, myCoor ' 円弧を描画
myDraw.DBAddEllipse 30, 30, 20, 10, 0, myLayer, myCoor ' 楕円を描画
myDraw.DBAddEllipsearc 40, 40, 20, 10, 3.141592 / 3, 0, 3.141592, myLayer, myCoor ' 楕円弧を描画

myDraw.Layer = myLayer ' アクティブレイヤーの変更

myDraw.DBDeleteEntity myEntity ' 線を消去

myDraw.SaveAs "C:\オートメーションテスト.it" ' ファイルに保存
Set myDraw = Nothing ' キャド終了