ページを更新する

Delphi で Bricscad を使う　2015/ 9/16

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

2019/01/03 SelectionSet の取得を修正しました。

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;
  lays := app.ActiveDocument.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;
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);

  // セレクションセットを取得
  selSet := doc.ActiveSelectionSet;
 // フィルターを作成
  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(selSet.Count));
  }

  // すべての図形から選択
  // 引数省略は、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;
  selset.Clear;
end;

procedure LayerBlink(doc: IAcadDocument; const layerName: string);
var
  i : integer;
  lays : IAcadLayers;
  lay : IAcadLayer;
begin
  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;
  // ズーム画層名
  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);
end;

end.