Delphi で Bricscad COM API (ActiveX) を使うためのサンプルコード 2019/01/03
BricsCAD の場合、「BricscadApp Type Library」 と、「BricscadDb Type Library」 、2つのタイプライブラリを取り込みます。
Delphi のメニュー「コンポーネント」 - 「コンポーネントのインポート」 - [タイプライブラリの取り込み]にチェックを付けて [次へ]
ボタンをクリック
「登録済みのライブラリ」から1つを選んで [次へ] ボタンをクリック。何もせずに [次へ] ボタンをクリック。「ユニットの作成」にチェックを付けて
[完了] ボタンをクリック。
これを繰り返すと、Importsフォルダに、BricscadApp_TLB.pas, BricscadDB_TLB.pas が作成されます。
使用するには、 uses 節に、BricscadApp_TLB, BricscadDB_TLB, Comobj, ActiveX を追加します。
他のCADの場合、IJCAD : 「GCAD 201? Object Library」、ZwCAD : 「ZWCAD 201? Type Library」、ARES
: 「PCAD_AC_X 4.? Type Library」と「PCAD_DB_X Type Library 4.?」の2つのタイプライブラリを取り込みます。
uses 節には、PCAD_DB_X_TLB, PCAD_AC_X_TLB (ARES)、GcadVbaLib_TLB (IJCAD)、 ZWCAD_TLB
(ZWCAD) を追加します。
※AcadLine, AcadText ... を ZcadLine, ZcadText ... に、acAlignmentLeft ...
を zcAlignmentLeft ... 等、読み替えが必要になります。
また、GetActiveOleObject() で入力するクラス名は、'AutoCAD.Application'、'BricscadApp.AcadApplication'、'Gcad.Application'(IJCAD)、'ZWCAD.Application'、'PCAD_AC_X.AcadApplication'(ARES)
です。
ちなみに、FindWindow(ClassName, WindowCaption) に使うクラス名は、'AfxMDIFrame140u' (AutoCAD
2019) ~ 'AfxMDIFrame110u' (AutoCAD 2016)、'BricscadMainWindow'。
(現 ARES は 'Qt5QWindowIcon' ですが、これだけでは特定できません。 IJCAD のクラス名は固定ではありません。以前の
AutoCAD のように毎回変わります。
ZWCAD は古い情報では、'ZwCADApplicationWindow' ですが、現 ZWCAD は、IJCAD と同様に起動するごとに変わるようです。)
■Bricscad を見つける
// BricsCAD が起動されているか(ウィンドウハンドルで判断) // 複数起動されている場合は、ターゲットがトップレベルであるとは限らない function IsBcadHwndActive: boolean; begin result := FindWindow('BricscadMainWindow', nil) <> 0; end; // BricsCAD が起動されているか function IsBcadActive: boolean; const BcadClassName = 'BricscadApp.AcadApplication'; var ClassID : TGUID; UnKnown : IUnknown; begin ClassID := ProgIDtoClassID(BcadClassName); // uses ActiveX for GetActiveObject result := Succeeded(GetActiveObject(ClassID, nil, Unknown)); end; // 起動中のBricsCAD を取得 function GetBcadApplication(var app: IAcadApplication; msgFlag: boolean): boolean; const BcadClassName = 'BricscadApp.AcadApplication'; begin result := True; try // GetActiveOleObject は,ClassName で指定されたクラスの // アクティブオブジェクトの IDispatch インターフェースへの参照を返します。 // Supports は、最初のパラメータで指定したオブジェクトまたはインターフェースが、 // 2番目のパラメータで指定したインターフェースをサポートするかどうかを示します。 // インターフェースをサポートしている場合、そのインターフェースを 3 番目のパラメータとして返し、true を返します。 if not Supports(GetActiveOleObject(BcadClassName), IAcadApplication, app) then begin if msgFlag then ShowMessage('サポートされていません.'); result := False; end; except if msgFlag then ShowMessage('有効な Bricscad が見つかりません.'); result := False; end; end;
■コマンド送信
app.RunCommand は、Enterの代わりに ";" が使えたり、キャンセル "^C" が使えます。
"¥" で入力待ちになります。なので、"¥" を含むネットワーク上のプリンタは指定できません。
plotcmd := 'PLOT;Y;model' + #13 + devname + #13 + ...
app.RunCommand(plotcmd);
doc.SendCommand は、コマンドラインに入力するのと同じ。
Enter や Cancel は文字コードを送る。(#13 は vbCr と同じ)
plotcmd := 'PLOT' + #13 + 'Y' + #13 + 'model' + #13 + devname + #13 + ...
app.ActiveDocument.SendCommamd(plotcmd);
※ RunCommand があるのは、Bricscad だけです。
※ ARES の場合、Enter は #10 (vbLf) を使用。「セミコロン (;) や復帰 (vbCr) 改行 (vbCrLf) は不可」と
サンプル XLSX にあります。
[ESC] は不明なので、PostMessage(AresApp.HWND_, WM_KEYDOWN, VK_ESCAPE, 0); で代替しています。
詳しくは、こちらを参照
type TDblAry = array of double; var vpt, vpts : OleVariant; ary : TDblAry; pt : array [0..2] of double; i : integer; s : string; dim, l, h : integer; begin // CAD へ渡す座標の作成(CAD から値をもらうときは、必要なし) // 1 次元バリアント配列を作成して、初期値を配置 vpt := VarArrayOf([0.0, 10.0, 20.0]); // または、 vpt := VarArrayCreate([0, 2], VarDouble); vpt[0] := 0.0; vpt[1] := 10.0; vpt[2] := 20.0; // 配列であるか if VarIsArray(vpt) then begin // 配列の次元数 dim := VarArrayDimCount(vpt); // 配列の下限 l := VarArrayLowBound(vpt, dim); // 配列の上限 h := VarArrayHighBound(vpt, dim); end; // バリアント配列のサイズ(添え字の上限)を変更 VarArrayRedim(vpt, 4); vpt[3] := 30.0; vpt[4] := 40.0; // バリアントから動的配列を作成 DynArrayFromVariant(Pointer(ary), vpt, TypeInfo(TDblAry)); // 動的配列からバリアント配列を作成 DynArrayToVariant(Variant(vpts), ary, TypeInfo(TDblAry)); // クリア(空にする) VarClear(vpt); VarClear(vpts); end;
procedure TForm1.Button10Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; vpt1, vpt2 : OleVariant; begin if GetBcadApplication(app, True) then begin doc := app.ActiveDocument; // キャンセルの場合はエラーになるので、try - except で処理を継続 try // Bricscad をアクティブに SetForegroundWindow(app.HWND_); // 引数省略は、EmptyParam を使う vpt1 := doc.Utility.GetPoint(EmptyParam, '1 点目の座標を指示 : '); vpt2 := doc.Utility.GetPoint(vpt1, '2 点目の座標を指示 : '); // キャンセル発行(コマンドラインの表示を戻す) app.RunCommand('^C'); except app.RunCommand('^C'); end; // バリアントが空でない if not VarIsEmpty(vpt2) then begin Memo1.Lines.Add(FloatToStr(vpt1[0]) + ',' + FloatToStr(vpt1[1])); Memo1.Lines.Add(FloatToStr(vpt2[0]) + ',' + FloatToStr(vpt2[1])); end; end; end;
procedure TForm1.Button13Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; idisp : IDispatch; vpt : OleVariant; ent : IAcadEntity; blkr: IAcadBlockReference; begin if GetBcadApplication(app, True) then begin try SetForegroundWindow(app.HWND_); doc := app.ActiveDocument; doc.Utility.GetEntity(idisp, vpt, '図形を選択 : '); app.RunCommand('^C');// キャンセルは #27 でも可 if Assigned(idisp) then begin ent := idisp as IAcadEntity; if ent.EntityName = 'AcDbBlockReference' then begin blkr := ent as IAcadBlockReference; // 分解(元のブロックは残る) blkr.Explode; end; end; except end; end; end;
procedure TForm1.Button1Click(Sender: TObject); type TDblAry = array of double; var app : IAcadApplication; doc : IAcadDocument; ss : IAcadSelectionSet; filterType, filterData: OleVariant; ent : IAcadEntity; lwp : IAcadLWPolyline; txt : IAcadText; lin : IAcadLine; vpt1, vpt2: OleVariant; i, j : integer; // 頂点座標用動的配列 ary : TDblAry; begin // 起動中の Bricscad を見つける if GetBcadApplication(app, True) then begin try doc := app.ActiveDocument; // セレクションセットを取得 ss := doc.ActiveSelectionSet; // 選択フィルターを作成 // 下記の場合は、画層'0' の 'TEXT' または 'LWPOLYLINE' AutoLISP の ssget と同じ filterType := VarArrayCreate([0, 1], varSmallInt); filterData := VarArrayCreate([0, 1], varVariant); filterType[0] := 8; // 画層 filterData[0] := '0,TEST'; filterType[1] := 0; // 図形名 filterData[1] := 'TEXT,*LINE'; // 図形名は、DXFグループコード 0: エンティティ―タイプ // Bricscad をアクティブに SetForegroundWindow(app.HWND_); // ユーザーによる図形選択(フィルター付き) ss.SelectOnScreen(filterType, filterData); // ユーザーによる図形選択(フィルター無し) //ss.SelectOnScreen(EmptyParam, EmptyParam); Memo1.Lines.Clear; if ss.Count > 0 then begin for i := 0 to ss.Count -1 do begin ent := ss.Item(i); Memo1.Lines.Add(ent.EntityName); // 図形名は、DXFグループコード 100:サブクラスマーカー if ent.EntityName = 'AcDbPolyline' then begin lwp := ent as IAcadLWPolyline; lwp.GetBoundingBox(vpt1, vpt2); // バリアント配列を動的配列に DynArrayFromVariant(Pointer(ary), lwp.Coordinates, TypeInfo(TDblAry)); for j := 0 to Length(ary) div 2 -1 do begin Memo1.Lines.Add(Format('%d: %.3f,%.3f',[j, ary[j * 2], ary[j * 2 + 1]])); end; end else if ent.EntityName = 'AcDbLine' then begin lin := ent as IAcadLine; vpt1 := lin.StartPoint; vpt2 := lin.EndPoint; Memo1.Lines.Add(Format('%.3f,%.3f - %.3f,%.3f', [Double(vpt1[0]), Double(vpt1[1]), Double(vpt2[0]), Double(vpt2[1])])); end else if ent.EntityName = 'AcDbText' then begin txt := ent as IAcadText; vpt1 := txt.InsertionPoint; Memo1.Lines.Add(Format('%.3f,%.3f',[Double(vpt1[0]), Double(vpt1[1])])); end; end; ss.Clear; end; except end; end; end;
procedure TForm1.Button4Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; ss : IAcadSelectionSet; blk : IAcadBlockReference; attr : BricscadDB_TLB.IAcadAttributeReference; filterType, filterData: OleVariant; attrs : OleVariant; i, j: Integer; idisp : IDispatch; begin if GetBcadApplication(app, False) then begin try doc := app.ActiveDocument; // セレクションセットを取得 ss := doc.ActiveSelectionSet; ss.Clear; // 選択フィルターを作成 filterType := VarArrayCreate([0, 0], varSmallInt); filterData := VarArrayCreate([0, 0], varVariant); filterType[0] := 0; filterData[0] := 'INSERT'; // Bricscad をアクティブに SetForegroundWindow(app.HWND_); // ユーザーによる図形選択(フィルター付き) ss.SelectOnScreen(filterType, filterData); // ユーザーによる図形選択(フィルター無し) //ss.SelectOnScreen(EmptyParam, EmptyParam); if ss.Count > 0 then begin for i := 0 to ss.Count -1 do begin Memo1.Lines.Add(ss.Item(i).EntityName); if ss.Item(i).EntityName = 'AcDbBlockReference' then begin blk := ss.Item(i) as IAcadBlockReference; Memo1.Lines.Add(blk.Name); // 属性があるか if blk.HasAttributes then begin attrs := blk.GetAttributes; for j := 0 to VarArrayHighBound(attrs, 1) do begin idisp := attrs[j]; attr := idisp as IAcadAttributeReference; Memo1.Lines.Add(attr.TagString + ':' + attr.TextString); end; end; end; end; ss.Clear; end; except end; end; end;
procedure TForm1.Button1Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; ss : IAcadSelectionSet; filterType, filterData: OleVariant; ent : IAcadEntity; i : integer; begin if GetBcadApplication(app, False) then begin try doc := app.ActiveDocument; // セレクションセットを取得 ss := doc.ActiveSelectionSet; // 選択フィルターを作成 filterType := VarArrayCreate([0, 0], varSmallInt); filterData := VarArrayCreate([0, 0], varVariant); filterType[0] := 8; // 画層 filterData[0] := '0'; // 画層名 // AutoLISP の ssget "X" と同じ ss.Select(acSelectionSetAll, EmptyParam, EmptyParam, filterType, filterData); // Mode は、"BricscadDB_TLB.acselect"まで入力すると、コード支援で、acselect...が表示されるので、 // それらしいものを選択する // または、BricscadDB_TLB.pas を開き、"AcSelect" を検索し、"列挙型 AcSelect の定数"以下の const を見る Memo1.Lines.Clear; if ss.Count > 0 then begin for i := 0 to ss.Count -1 do begin ent := ss.Item(i); Memo1.Lines.Add(ent.EntityName); end; ss.Clear; end; except end; end; end;
procedure TForm1.Button7Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; blks : IAcadBlocks; blkr : IAcadBlockReference; ent : IAcadEntity; vpt : OleVariant; fname : TFileName; i : integer; blkName : string; ents : OleVariant; idisp : IDispatch; begin if GetBcadApplication(app, False) then begin try doc := app.ActiveDocument; vpt := VarArrayCreate([0, 2], VarDouble); vpt[0] := 0; vpt[1] := 0; vpt[2]:= 0; if OpenDialog1.Execute then begin fname := OpenDialog1.FileName; // ブロック挿入 blkr := doc.ModelSpace.InsertBlock(vpt, fname, 1, 1, 1, 0, ''); blkName := blkr.Name; // 分解 (ブロックは残っている) ents := blkr.Explode; // 分解した図形を処理 for i := 0 to VarArrayHighBound(ents, 1) do begin idisp := ents[i]; ent := idisp as IAcadEntity; ent.color := acByLayer; ent.Linetype := 'BYLAER'; ent.Layer := 'TEST'; // 画層が無い場合は、エラーになる Memo1.Lines.Add(ent.EntityName); end; // 画面上のブロックを削除 blkr.Erase; blks := doc.Blocks; for i := blks.Count -1 downto 0 do begin //Memo1.Lines.Add(blks.Item(i).Name); if blks.Item(i).Name = blkName then begin // データベースから削除 blks.Item(i).Delete; break; end; end; end; except end; end; end;
procedure TForm1.Button9Click(Sender: TObject); var app: IAcadApplication; lays : IAcadLayers; lay : IAcadLayer; i : integer; s : string; Ticks : Cardinal; begin if GetBcadApplication(app, False) then begin lays := app.ActiveDocument.Layers; Memo1.Lines.Add(lays.Count.ToString); Ticks := GetTickCount; for i := 0 to lays.Count -1 do begin lay := lays.Item(i); s := lay.Name; end; // 結構遅い 1140msec / 365 Layers Memo1.Lines.Add((GetTickCount-Ticks).ToString); // すでにある場合でもエラーにはならない lay := lays.Add('TEST'); lay.color := acYellow; // Autocad Color Index end; end;
procedure TForm1.Button14Click(Sender: TObject); var app : IAcadApplication; i : integer; begin if GetBcadApplication(app, True) then begin for i := 0 to app.Documents.Count -1 do begin Memo1.Lines.Add(app.Documents.Item(i).FullName); app.ActiveDocument := app.Documents.Item(i); app.ZoomExtents; end; end; end;
procedure TForm1.Button11Click(Sender: TObject); type TDblAry = array of double; var app : IAcadApplication; doc : IAcadDocument; lwp : IAcadLWPolyline; vpts : OleVariant; vpt : OleVariant; // 頂点座標用動的配列 ary : TDblAry; begin if GetBcadApplication(app, False) then begin doc := app.ActiveDocument; // 動的配列を使う SetLength(ary, 8); ary[0] := 100; ary[1] := 200; ary[2] := 300; ary[3] := 200; ary[4] := 300; ary[5] := 0; ary[6] := 100; ary[7] := 0; DynArrayToVariant(Variant(vpts), ary, TypeInfo(TDblAry)); lwp := doc.ModelSpace.AddLightWeightPolyline(vpts); // 閉鎖 lwp.Closed := True; lwp.color := acRed; // 空にする VarClear(vpts); // 動的配列を使わない場合 vpts := VarArrayCreate([0, 7], VarDouble); vpts[0] := 200; vpts[1] := 100; vpts[2] := 200; vpts[3] := 300; vpts[4] := 0; vpts[5] := 300; vpts[6] := 0; vpts[7] := 100; lwp := doc.ModelSpace.AddLightWeightPolyline(vpts); lwp.color := acYellow; vpt := VarArrayCreate([0, 1], VarDouble); vpt[0] := vpts[0]; vpt[1] := vpts[1]; // 頂点を追加 lwp.AddVertex(4, vpt); end; end;
procedure TForm1.Button12Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; blk : IAcadBlock; cir : IAcadCircle; vpt : OleVariant; vpt1 : OleVariant; blkr : IAcadBlockReference; begin // ブロックがすでにあるかの確認は時間がかかるので、とりあえず挿入してみて、エラーが出たらブロックを作成する // 毎回作成したほうが速い場合がある if GetBcadApplication(app, false) then begin doc := app.ActiveDocument; vpt := VarArrayCreate([0, 2], VarDouble); vpt1 := VarArrayCreate([0, 2], VarDouble); vpt1[0] := 100; vpt1[1] := 100; // ブロックの有無を確認せずに、挿入してみる // 無い場合はエラーになる try blkr := doc.ModelSpace.InsertBlock(vpt1, 'TEST', 1,1,1,0,''); except end; // 挿入できなかったら、ブロックを作成して、挿入 if not Assigned(blkr) then begin blk := doc.Blocks.Add(vpt, 'TEST'); // すでにある場合もエラーにはならない // 既存のブロックも新しいブロックに変更される cir := blk.AddCircle(vpt, 20.0); cir.color := acByBlock; cir.Linetype := 'BYBLOCK'; cir := blk.AddCircle(vpt, 25.0); cir.color := acByBlock; cir.Linetype := 'BYBLOCK'; blkr := doc.ModelSpace.InsertBlock(vpt1, 'TEST', 1,1,1,0,''); end; end; end;
procedure TForm1.Button15Click(Sender: TObject); var app : IAcadApplication; doc : IAcadDocument; layout : IAcadLayout; devnames, papernames, tablenames : OleVariant; i : integer; begin if GetBcadApplication(app, True) then begin doc := app.ActiveDocument; layout := doc.ActiveLayout; layout.RefreshPlotDeviceInfo; // プリンター名の列挙 devnames := layout.GetPlotDeviceNames; for i := 0 to VarArrayHighBound(devnames, 1) do Memo1.Lines.Add(devnames[i]); // 用紙名を列挙 papernames := layout.GetCanonicalMediaNames; for i := 0 to VarArrayHighBound(papernames, 1) do Memo1.Lines.Add(papernames[i]); tablenames := layout.GetPlotStyleTableNames; // 印刷スタイル CTB,STB を列挙 for i := 0 to VarArrayHighBound(tablenames, 1) do Memo1.Lines.Add(tablenames[i]); // プリンターをセット layout.ConfigName := 'Brother HL-L2360D series Printer'; layout.CanonicalMediaName := 'A4'; layout.StyleSheet := 'monochrome018.ctb'; // acDisplay, acExtents, acLimits, acView, acWindow, acLayout layout.PlotType := acLimits; layout.CenterPlot := True; layout.UseStandardScale := False; layout.SetCustomScale(1.0, 14.14);// 分子、分母の順 layout.RefreshPlotDeviceInfo; // 尺度変更のため再作図が必要 doc.Regen(acAllViewports); // 印刷実行 doc.Plot.PlotToDevice(layout.ConfigName); end; end;