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

実はこれ、随分悩みました。選択セットを使えばいいのはすぐに解ったのですが、作成したプログラムを動かすと１度目は動くのに、２度目からはエラーになる。なぜか？？？１度選択セットを作成するとそれはAutoCAD上に残ってしまいます。そのため同一名の選択セットがAutoCAD上に存在しないかチェックしないと２度目からはエラーとなるのです。

VBのプログラムでAutoCAD 2000の状態が解らなくなったときは、プログラムをブレイクしウオッチ式の追加で「AcadDoc」（VBAのときは「ThisDrawing」）を見ると理解しやすいと思います。

選択セット作成時に同一名が無いかチェックしています。サンプルは選択されたオブジェクトを赤にします。

ActiveX 選択セット サンプルソース

' ActiveX Sample for AutoCAD 2000 ' '　　　by akira nishio 2000.1.3 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 '********** ActiveX 選択セット サンプル *********** Dim sset As AcadSelectionSet Dim SsetName As String Dim i As Long Dim con As Long SsetName = "SS1" con = AcadDoc.SelectionSets.Count i = 0 Do 　　If i = con Then 　　　　'同一名の選択セットが無い場合は新規に作成 　　　　Set sset = AcadDoc.SelectionSets.Add(SsetName) 　　　　Exit Do 　　ElseIf SsetName = AcadDoc.SelectionSets.Item(i).Name Then　 　　　　'同一名の選択セットが有る場合は選択セットをクリア 　　　　Set sset = AcadDoc.SelectionSets.Item(i) 　　　　sset.Clear 　　　　Exit Do 　　End If i = i + 1 Loop 'AutoCADへフォーカスを移す AppActivate AcadApp.Caption 'AutoCADの表示を最大化 AcadApp.WindowState = acMax 'AutoCAD 画面上でオブジェクトを選択するよう要求 sset.SelectOnScreen Dim ent As Object For Each ent In sset 　　ent.Color = acRed '各オブジェクトの色を赤に変更 　　ent.Update '各オブジェクトを更新 Next ent End Sub