ページを更新する

Delphi で Bricscad COM API (ActiveX) を使うためのサンプルコード 2019/01/03

BricsCAD の場合、「BricscadApp Type Library」 と、「BricscadDb Type Library」 、２つのタイプライブラリを取り込みます。

　Delphi のメニュー「コンポーネント」 - 「コンポーネントのインポート」 - [タイプライブラリの取り込み]にチェックを付けて [次へ] ボタンをクリック
　「登録済みのライブラリ」から１つを選んで [次へ] ボタンをクリック。何もせずに [次へ] ボタンをクリック。「ユニットの作成」にチェックを付けて [完了] ボタンをクリック。
　これを繰り返すと、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.?」の２つのタイプライブラリを取り込みます。
　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;