Delphi で Bricscad を使う 2015/ 9/16

ほぼ、自分のためのメモです。バリアント配列の取り扱い、選択セット、フィルターの作成...等、何かの参考にして下さい。
※タイプライブラリの取り込みは、「Delphi で Bricscad 画面キャプチャ」のページを参考にして下さい。


unit FNaviZoomUnit3;

interface

uses
  //BricscadApp_TLB, BricscadDb_TLB, ComObj を追加
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, BricscadApp_TLB, BricscadDb_TLB,
  Vcl.StdCtrls, ComObj, Vcl.CheckLst;
type
  TForm3 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

//画層名を取得
procedure TForm3.Button1Click(Sender: TObject);
var
  app : IAcadApplication;
  doc : IAcadDocument;
  lays : IAcadLayers;

  i : integer;
  s : string;
begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていません.');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;
  try
    doc := app.ActiveDocument;
    lays := doc.Layers;
    ListBox1.Items.Clear;
    for i := 0 to lays.Count - 1 do begin
      s := Copy(lays.Item(i).Name, 1, 5);
      if s = 'ZOOM_' then
        ListBox2.Items.Add(lays.Item(i).Name);
    end;
  except
    ;
  end;
end;

procedure LayerZoom(doc: IAcadDocument;const layerName: string);
var
  selSets : IAcadSelectionSets;
  selSet  : IAcadSelectionSet;
  filterType, filterData: OleVariant;
  ent : IAcadEntity;
  minPoint, maxPoint : OleVariant;
  i ,j : integer;
  vpt1, vpt2: OleVariant;

begin
  // 3D座標を用意
  vpt1 := VarArrayCreate([0, 2], varDouble);
  vpt2 := VarArrayCreate([0, 2], varDouble);

  // セレクションセットを作成
  selSets := doc.SelectionSets;
  // すでに存在する場合は、それを使用
  if selSets.Count > 0 then begin
    setSet := selSets.Item(0);
    selSet.Clear;
  end
  else
  // 無いときは、あらたに作成
    selSet := selSets.Add('SS_TEMP');

  // フィルターを作成
  filterType := VarArrayCreate([0, 0], varSmallInt);
  filterData := VarArrayCreate([0, 0], varVariant);
  filterType[0] := 8; // 画層
  filterData[0] := layerName; // 画層名
  
  // フィルター作成例
  // 画層が WIRE または、*SENBAN で 図形が、INSERT またはLINE
  {
  filterType := VarArrayCreate([0, 1], varSmallInt);
  filterData := VarArrayCreate([0, 1], varVariant);
  filterType[0] := 8; // 画層
  filterData[0] := 'WIRE,*SENBAN'; // 画層名
  filterType[1] := 0; // 図形
  filterData[1] := 'INSERT,LINE'; // 図形名
  selSet.SelectOnScreen(filterType, filterData);
  ShowMessage('選択数= ' + IntToStr(ss.Count));
  selSet.Delete;
  }

  try
    // すべての図形から選択
    // 引数省略は、EmptyParam を使う
    selset.Select(acSelectionSetAll, EmptyParam, EmptyParam, filterType, filterData);
    if selset.Count > 0 then begin
      for i := 0 to selSet.Count - 1 do begin
        // 図形を取得
        ent := selset.Item(i);
        // その矩形範囲を取得
        ent.GetBoundingBox(vpt1, vpt2);
        // 図形範囲の最小、最大を取得
        if i = 0 then begin
          minPoint := vpt1;
          maxPoint := vpt2;
        end
        else begin
          // 比較は、2D座標(x,y) のみ
          for j := 0 to 1 do begin
            if vpt1[j] < minPoint[j] then minPoint[j] := vpt1[j];
            if vpt2[j] > maxPoint[j] then maxPoint[j] := vpt2[j];
          end;
        end;
      end;
      // その範囲をズーム
      doc.Application.ZoomWindow(minPoint, maxPoint);
    end;
  finally
    selset.Clear;
    // 必ず必要
    selset.Erase;
  end;
end;

procedure LayerBlink(doc: IAcadDocument; const layerName: string);
var
  i : integer;
  lays : IAcadLayers;
  lay : IAcadLayer;
begin
  lay := nil;
  lays := doc.Layers;
  for i := 0 to lays.Count - 1 do begin
    if lays.Item(i).Name = layerName then begin
      lay := lays.Item(i);
      break;
    end;
  end;
  if Assigned(lay) then begin
    for i := 1 to 19 do begin
      if i mod 2 = 0 then
        // 赤色
        lay.color := 1
      else
        // BYLAYER
        lay.color := 255;
      doc.Regen(0);
      Sleep(50);
    end;
  end;
end;

procedure TForm3.ListBox1Click(Sender: TObject);
var
  app : IAcadApplication;
  doc : IAcadDocument;
  s : string;
begin
  try
    if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
      ShowMessage('サポートされていません.');
      exit;
    end;
  except
    ShowMessage('有効な BricsCAD が見つかりません.');
    exit;
  end;
  try
    // ズーム画層名
    with ListBox1 do s := Items[ItemIndex];

    // アクティブドキュメントを取得
    doc := app.ActiveDocument;
    // 画層内の図形範囲をズーム
    LayerZoom(doc, s);

    doc.SetVariable('EXPERT', 5);
    doc.SetVariable('CLAYER', s);
    app.RunCommand('-LA OFF ZOOM_*' + #13);
    app.RunCommand('ON ' + s + #13#13);
    doc.SetVariable('EXPERT', 1);
  except
    ShowMessage('エラーが発生しました.');
  end;
end;

end.