DcadCapture ver.2015.5.3 for DraftSight 2015 / ARES Commander 2015

※ARES は廉価版でも COM API (ActiveX) が使えます。そちらを使ったほうがスマートです。

Bricscad 用のキャプチャーソフトを DraftSight / ARES 用に改造してみました。
キャプチャーした図面イメージをダブルクリックすると、CADの図面が切り替わります。
フォームの大きさは、自由に変更できます。

・コマンドラインに文字列を流し込む方法なので、タイミングが合わない場合があります。
・クリップボードを使用してコマンド履歴を取得しているため、操作後は、クリップボードに文字列が残ります。
・図面の切り替えは、メニューを操作しています。
　取得した時の図面数と、「メニュー」 - 「ウィンドウ」の図面数が合わない場合は、「閉じる」、「すべて閉じる」が選択される可能性があります。
　※ARES では、「Classic Default」 表示にしておいて下さい。
・高解像度のPCでは、キャプチャー位置が合わないときがあります。DcadCapture.exe のプロパティーから、「高解像度DPI...」にチェックを付けて下さい。

・各所にタイミングをとるためのタイマーを入れているため、取得にかなり時間がかかります。
　（ 2015/5/3 ：若干改善しました。23図面 130sec -> 45sec）

■履歴
2015/04/22
　・初版作成
2015/04/28
　・シート番号、またはページ番号を取得するを追加
　・マウス右クリックのポップアップメニューに「再キャプチャ」を追加
2015/04/28（２回目）
　・システム変数の取得を、属性と同様にDXFファイルから取得に変更。若干高速にした。
2015/05/03
　・コマンド送信で、[Enter]、[ESC] の送信を追加。
　・不要なタイミングタイマーを極力省いた。

■Draftsight 2015

■ARES Commander 2015

■ダウンロード
　DcadCapture.zip (2015/05/03 EXE本体のみ）

■ソースコード

unit DcadCaptureUnit;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,{BricscadApp_TLB, BricscadDb_TLB,}
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, ComObj, IniFiles, Vcl.Buttons,
  Vcl.Menus, ClipBrd ;
 
type
  TDwgDoc = record
    Index : integer;
    Name : string;
    Comment : string;
  end;
type
  TForm2 = class(TForm)
    DrawGrid1: TDrawGrid;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    N3: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    N4: TMenuItem;
    N5: TMenuItem;
    Edit1: TEdit;
    SpeedButton4: TSpeedButton;
    procedure FormDestroy(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormResize(Sender: TObject);
    procedure DrawGrid1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure DrawGrid1Click(Sender: TObject);
    procedure DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N5Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
 
    // 取得するブロック名と属性名
    BlkName, BlkName1, BlkName2, AttName, AttName1, AttName2 : string;
    AttFlag1, AttFlag2 : boolean;
 
    // 連続実行するLISP
    LspFileName : TFileName;
    LspCmdName  : string;
    LspCommand  : string;
 
    MoveX, MoveY : integer;
  end;
 
var
  Form2: TForm2;
 
  // キャプチャしたビットマップを保持
  BmpAry : array of TBitMap;
  // 図面名とその位置を保持
  DwgDocAry : array of TDwgDoc;
  // ビットマップの大きさ
  BmpW, BmpH : integer;
  // タイトル表示の高さ
  TitleH1, TitleH2 : integer;
  // シート名、ページ番号を表示する
  CmtDispFlag : boolean;
  // キャプチャ時、属性を取得
  CmtGetFlag  : boolean;
  BcadActiveFlag : boolean;
 
  // メインウィンドウ
  DcadMainWinHandle : HWND;
  DcadMDIClientWinHandle : HWND;
  DcadCommandWinHandle : HWND;
  DcadInputWinHandle : HWND;
  DcadOutputWinHandle : HWND;
  DcadMDIActiveWinHandle : HWND;
  DcadMDIChildWinHandle : HWND;
  DCadProcessID : DWORD;     //プロセスID
 
implementation
 
 
{$R *.dfm}
 
uses DcadCaptureCfgUnit;
 
//****************************************
// 最後の指定文字列より後を得る
//****************************************
function LastSubstringAfter(const ststr, s: string):String;
var
  st, stlen : integer;
  temp : string;
begin
  Result := '';
  if Pos(ststr, s) > 0 then begin
    temp := s;
 
    stlen := Length(ststr);
    while Pos(ststr, temp) > 0 do begin
      st := Pos(ststr, temp) + stlen;
      temp := Copy(temp, st, Length(temp) - st + 1);
      if temp = '' then break;
    end;
    Result := Trim(temp);
  end;
end;
 
//****************************************
//最初に現れたststrからedstrまでを返す
//****************************************
function StrAfterStrBefore(const ststr, edstr, s:string):String;
var
  st, ed:integer;
  temp : string;
begin
  Result:='';
  st:=Pos(ststr,s);
  if st > 0 then begin
    temp := s;
    Delete(temp,1,st + Length(ststr)-1);
    ed := Pos(edstr, temp)-1;
    if ed >= 0 then
      Result := Trim(Copy(temp, 1, ed));
  end;
end;
 
//****************************************
// 最後の指定文字列より後を得る
//****************************************
function LastStrAfter(const ststr, s: string):String;
var
  st, stlen : integer;
  temp : string;
begin
  Result := '';
  if Pos(ststr, s) > 0 then begin
    temp := s;
 
    stlen := Length(ststr);
    while Pos(ststr, temp) > 0 do begin
      st := Pos(ststr, temp) + stlen;
      temp := Copy(temp, st, Length(temp) - st + 1);
      if temp = '' then break;
    end;
    Result := Trim(temp);
  end;
end;
//******************************************
// ウィンドウのタイトル（キャプション）を得る
//******************************************
function GetWindowCaption(h : HWND) : string;
var
  Title : array [0..255] of char;
begin
  result := '';
  if GetWindowText(h, Title, 255) <> 0 then
    result := Title;
end;
//****************************************
// メインウィンドウ用コールバック関数
//****************************************
function EnumWindowProcMainWin(h: HWND; lp: LParam): BOOL; stdcall;
var
  Title : array [0..255] of char;
  ClassName : array [0..255] of char;
begin
  Result := true;
  GetClassName(h, ClassName, 255);
  if 'Qt5QWindowIcon' = ClassName then begin
    // タイトルを得る
    if GetWindowText(h, Title, 255) <> 0 then begin
      if (Pos('DraftSight - [', Title) = 1) or
        (Pos('ARES Commander 2015 - [', Title) = 1) then begin
        DCadMainWinHandle := h;
        GetWindowThreadProcessId(h, @DCadProcessID);
        Result := false;
      end;
    end;
  end;
end;
 
//****************************************
// メインウィンドウのハンドルを得る
//****************************************
function GetDCadMainWinHandle : HWND;
begin
 
  EnumWindows(@EnumWindowProcMainWin, 0);
  Result := DCadMainWinHandle;
end;
 
// ************************************
// MDIClientウィンドウ取得用コールバック関数
// ************************************
function EnumCWinProc_MDIClient(h:HWND;lparam:Integer):Bool;stdcall;
var
  Title : array [0..255] of char;
begin
  Result:=True;
  if GetWindowText(h, Title, 255) <> 0 then begin
    if 'CFxWorkspaceImplClassWindow' = Title then begin
      DcadMDIClientWinHandle := GetWindow(h, GW_CHILD);
      DcadMDIChildWinHandle := GetWindow(DcadMDIClientWinHandle, GW_CHILD);
      Result := False;
    end;
  end;
end;
 
// ************************************
// MDIClientウィンドウ取得
// 実際には、WindowsのMDIClientでは無い
// ************************************
function GetDcadMDIClientHandle:HWND;
begin
  EnumChildWindows(DcadMainWinHandle,@EnumCwinProc_MDIClient,0);
  result:=DcadMDIClientWinHandle;
end;
 
// ************************************
// コマンドウィンドウ取得用コールバック関数
// ************************************
function EnumCWinProc_CommandWinHandle(h: HWND; lparam: Integer):Bool;stdcall;
var
  Title : array [0..255] of char;
begin
  Result:=True;
  if GetWindowText(h, Title, 255) <> 0 then begin
    if 'CFxCommandWindowWindow' = Title then begin
      DcadCommandWinHandle := h;
      Result:=False;
    end;
  end;
end;
 
// ************************************
// コマンドラインウィンドウを取得
// ************************************
function GetDcadCommandWinHandle:HWND;
begin
  EnumChildWindows(DcadMainWinHandle, @EnumCwinProc_CommandWinHandle, 0);
  result := DcadCommandWinHandle;
  if result <> 0 then begin
    DcadOutputWinHandle := GetWindow(DcadCommandWinHandle, GW_CHILD);
    DcadInputWinHandle := GetWindow(DcadOutputWinHandle, GW_HWNDNEXT);
  end;
end;
 
// ************************************
// 対象ウィンドウに文字列を送信
// ************************************
function SendHwndCmdLine(hCmdLine: HWND; const cmd : string):boolean;
var
  i : integer;
begin
  Result := False;
  if hCmdLine <> 0 then begin
    // 文字列を送信
    for i := 1 to Length(cmd) do begin
      if cmd[i] = #13 then begin
        SendMessage(hCmdLine, WM_KEYDOWN,VK_RETURN, 0);
        SendMessage(hCmdLine, WM_KEYUP,  VK_RETURN, 0);
        Sleep(1);
      end
      else if (cmd[i] = #27) or (cmd[i] = #3) then begin
        SendMessage(hCmdLine, WM_KEYDOWN, VK_ESCAPE, 0);
        SendMessage(hCmdLine, WM_KEYUP,   VK_ESCAPE, 0);
        Sleep(1);
      end
      else begin
        SendMessage(hCmdLine, WM_CHAR, Word(cmd[i]), 0);
        if cmd[i] = #20 then Sleep(1);
      end;
    end;
    result := true;
  end;
end;
// ************************************
// コマンドラインに文字列を送信
// ************************************
function SendDcadCommand(const cmd: string): boolean;
begin
  GetDcadCommandWinHandle;
  Result := SendHwndCmdLine(DcadInputWinHandle, cmd);
end;
 
function GetDcadVariable(const SysVar: string): string;
var
  s : string;
begin
  Result := '';
 
  GetDCadMainWinHandle;
 
  SetForegroundWindow(DcadMainWinHandle);
  SendDcadCommand(SysVar + #13#3);
 
  Sleep(10);
 
  SendDcadCommand('COPYHISTORY'#13);
  Sleep(200);
  s := '';
  try
    s := ClipBoard.AsText;
    s := LastSubstringAfter(': ' + SysVar, s);
 
    Result := '';
    if (Pos('=', s) > 0) and (Pos('(', s) > 1) then
      Result := Trim(StrAfterStrBefore('=', '(', s));
    if (Result = '') and (Pos('(', s) > 0) and (Pos(')', s) > 1) then
      Result := Trim(StrAfterStrBefore('(', ')', s));
    if (Result = '') and (Pos('デフォルト:', s)>0) then begin
      Result := Trim(StrAfterStrBefore('デフォルト:', #13, s));
    end;
  except
    ;
  end;
end;
 
// ************************************
// CAD をアクティブに
// ************************************
function SetDcadActive:boolean;
begin
  Result := False;
  GetDCadMainWinHandle;
  if IsWindow(DcadMainWinHandle) then begin
    SetForegroundWindow(DcadMainWinHandle);
    Result := True;
  end;
end;
 
//****************************************
// 画面の指定位置をBitmapに変換
//****************************************
procedure CaptureToBmp(Lf, Tp, W, H: Integer; bmp: TBitmap);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen : HDC;
begin
  bmp.Width := W;
  bmp.Height := H;
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  try
    BitBlt( bmp.Canvas.Handle, 0, 0, W, H, hdcScreen, Lf, Tp, SRCCOPY or CAPTUREBLT);
  finally
    DeleteDC(hdcScreen);
  end;
end;
 
// *******************************
// DwgDocAryをソート
// *******************************
procedure SortDwgDocAry;
var
  len, n, m : integer;
  i, j: integer;
  DwgDocTmp : TDwgDoc;
  s, s1 : string;
begin
  n := Length(DwgDocAry);
  if n > 1 then begin
 
    // コメント文字列の最大文字数
    len := 0;
    for i := 0 to n -1 do begin
      m := DwgDocAry[i].Comment.Length;
      if len < m then len := m;
    end;
    // 文字列比較のため同じ長さにする
    for i := 0 to n -1 do begin
      with DwgDocAry[i] do begin
        m := Comment.Length;
        if m < len then begin
          for j := 1 to len - m do begin
            Comment:= ' ' + Comment;
          end;
        end;
      end;
    end;
    // ソート
    for i := 0 to n - 2 do begin
      s := DwgDocAry[i].Comment + ':' + DwgDocAry[i].Name;
      for j := i + 1 to n - 1 do begin
        s1 := DwgDocAry[j].Comment + ':' + DwgDocAry[j].Name;
        if s1 < s then begin
          DwgDocTmp := DwgDocAry[i];
          DwgDocAry[i] := DwgDocAry[j];
          DwgDocAry[j] := DwgDocTmp;
          s := s1;
        end;
      end;
    end;
  end;
end;
 
// ************************************
// DrawGrid 同期
// ************************************
procedure TForm2.ComboBox1Change(Sender: TObject);
var
  idx : integer;
  i : integer;
begin
  with ComboBox1 do begin
    idx := ItemIndex;
    if idx >= 0 then
      i := Integer(Items.Objects[idx])
    else
      i := -1;
  end;
  if (i >= 0) and (i < Length(DwgDocAry)) then begin
    with DrawGrid1 do begin
      Col := i mod ColCount;
      Row := i div ColCount;
    end;
  end;
end;
 
// ************************************
// コンボボックスを同期
// ************************************
procedure TForm2.DrawGrid1Click(Sender: TObject);
var
  i : integer;
begin
  with DrawGrid1 do
    i := Row * ColCount + col;
  ComboBox1.ItemIndex := i;
end;
 
// ************************************
// 図面切り替え
// ************************************
procedure TForm2.DrawGrid1DblClick(Sender: TObject);
var
  i, id, j : integer;
begin
 
  with DrawGrid1 do begin
    i := Row * ColCount + col;
    if (i >= 0) and (i < Length(DwgDocAry)) then begin
      id := DwgDocAry[i].Index;
 
      if GetDCadMainWinHandle = 0 then Exit;
 
      SetForegroundWindow(DcadMainWinHandle);
 
      // メニュー操作
      keybd_event(VK_MENU, 0, 0, 0);
      keybd_event(Ord('W'), 0, 0, 0);
      keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
      keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
 
      for j := 0 to id + 4 do begin
        keybd_event(VK_DOWN, 0 ,0 ,0);
        keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
      end;
 
      keybd_event(VK_RETURN, 0, 0, 0);
      keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
 
      ComboBox1.ItemIndex := i;
      //if BcadActiveFlag then
      //  SetForegroundWindow(DcadMainWinHandle);
    end;
  end;
  //if not BcadActiveFlag then
  //  SetForegroundWindow(Handle);
end;
 
// **************************
// キャプチャ画像を描画
// **************************
procedure TForm2.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i, w, h, dx, dy : integer;
  idx : integer;
begin
  with DrawGrid1 do begin
    // 現在の表示位置
    i := ARow * ColCount + Acol;
 
    idx := -1;
    if (i >= 0) and (i < Length(DwgDocAry)) then
      idx := DwgDocAry[i].Index;
 
    if (idx >= 0) and (idx < Length(BmpAry)) then begin
      w := BmpAry[idx].Width;
      h := BmpAry[idx].Height;
 
      dx := (DefaultColWidth - w) div 2;
 
      if not CmtDispFlag then
        dy := (DefaultRowHeight - h - TitleH1) div 2
      else
        dy := (DefaultRowHeight - h - TitleH2) div 2;
 
      with Canvas do begin
        if not CmtDispFlag then
          Draw(Rect.Left + dx, Rect.Top + dy + TitleH1, BmpAry[idx])
        else
          Draw(Rect.Left+dx,Rect.Top+dy + TitleH2, BmpAry[idx]);
 
        // 背景を塗りつぶし
        if (ARow = Row) and (ACol = Col) then
          Brush.Color := clBlue
        else
          Brush.Color := clGray;
 
        if not CmtDispFlag then
          Rectangle(Rect.Left + 1, Rect.Top + 1, Rect.Right - 1, Rect.Top + TitleH1 + 1)
        else
          Rectangle(Rect.Left + 1, Rect.Top + 1, Rect.Right - 1, Rect.Top + TitleH2 + 1);
 
        Font.Color := clWHITE;
 
        // タイトルを描画
        TextOut(Rect.Left + 3, Rect.Top + 3, ExtractFileName(DwgDocAry[i].Name));
 
        // コメントを描画
        if CmtDispFlag then
          TextOut(Rect.Left + 3, Rect.Top + 3 + TitleH1 + 1, DwgDocAry[i].Comment);
 
        // 標準の設定に戻す
        Pen.Style := psSolid;
        Brush.Style := bsClear;
        Pen.Color := clGray;
        Pen.Width := 1;
        Rectangle(Rect);
      end;
    end
    else begin
      with Canvas do begin
        Brush.Color := clWhite;
        FillRect(Rect);
      end;
    end;
  end;
end;
 
// ************************************
// マウス座標を保持
// ************************************
procedure TForm2.DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  MoveX := X;
  MoveY := Y;
end;
 
// ************************************
// フォーム生成
// ************************************
procedure TForm2.FormCreate(Sender: TObject);
var
  ini : TIniFile;
begin
  SetLength(BmpAry, 0);
  SetLength(DwgDocAry, 0);
 
  BmpH := 168;
  BmpW := 240;
  TitleH1 := 20;
  TitleH2 := 42;
 
  with DrawGrid1 do begin
    DefaultColWidth := BmpW;
    DefaultRowHeight := BmpH + 20;
    Options := Options + [goThumbTracking];
  end;
 
  BlkName := 'TITLE';
  AttName := 'ZSHEET';
  BlkName1 := BlkName;
  AttName1 := AttName;
  BlkName2 := BlkName;
  AttName2 := AttName;
  AttFlag1 := True;
  AttFlag2 := False;
 
  // ダブルクリックで Bricscad をアクティブに
  BcadActiveFlag := False;
 
  // コメント表示
  CmtDispFlag := False;
 
  // キャプチャ時、コメントを取得
  CmtGetFlag := True;
 
  LspFileName := '';
  LspCmdName := '';
  LspCommand := '';
 
  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    with Ini do begin
      Top := ReadInteger('Form', 'Top', Top);
      Left := ReadInteger('Form', 'Left', Left);
      Width:= ReadInteger('Form', 'Width', Width);
      Height := ReadInteger('Form', 'Height', Height);
      if Left >=  Screen.Width then Left := (Screen.Width + Width) div 2;
      if Top >= Screen.Height then Top := (Screen.Height + Height) div 2;
 
      BlkName1 := ReadString('Dcad', 'BlkName1', BlkName1);
      BlkName2 := ReadString('Dcad', 'BlkName2', BlkName2);
      AttName1 := ReadString('Dcad', 'AttName1', AttName1);
      AttName2 := ReadString('Dcad', 'AttName2', AttName2);
      AttFlag1 := ReadBool('Dcad', 'AttFlag1', AttFlag1);
      AttFlag2 := ReadBool('Dcad', 'AttFlag2', AttFlag2);
 
      BcadActiveFlag := ReadBool('Dcad', 'ActiveFlag', BcadActiveFlag);
 
      CmtDispFlag := ReadBool('DcadCapt', 'CmtDispFlag', CmtDispFlag);
      CmtGetFlag := ReadBool('DcadCapt', 'CmtGetFlag', CmtGetFlag);
 
      LspFileName := ReadString('Dcad', 'LispFileName', LspFileName);
      LspCmdName := ReadString('Dcad', 'LispCmdName', LspCmdName);
      LspCommand := ReadString('Dcad', 'LispCommand', LspCommand);
 
      // メニュー
      N2.Caption := LspCmdName;
      SpeedButton2.Caption := LspCmdName;
    end;
  finally
    ini.Free;
  end;
end;
 
// ************************************
// フォーム破棄
// ************************************
procedure TForm2.FormDestroy(Sender: TObject);
var
  i : integer;
  ini : TIniFile;
begin
  if Length(BmpAry) > 0 then begin
    for i := 0 to Length(BmpAry) -1 do
      BmpAry[i].Free;
  end;
  ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  try
    with Ini do begin
      WriteInteger('Form', 'Top', Top);
      WriteInteger('Form', 'Left', Left);
      WriteInteger('Form', 'Width', Width);
      WriteInteger('Form', 'Height', Height);
 
      WriteString('Dcad', 'BlkName1', BlkName1);
      WriteString('Dcad', 'BlkName2', BlkName2);
      WriteString('Dcad', 'AttName1', AttName1);
      WriteString('Dcad', 'AttName2', AttName2);
      WriteBool('Dcad', 'AttFlag1', AttFlag1);
      WriteBool('Dcad', 'AttFlag2', AttFlag2);
 
      WriteBool('Dcad', 'ActiveFlag', BcadActiveFlag);
 
      WriteBool('DcadCapt', 'CmtDispFlag', CmtDispFlag);
      WriteBool('DcadCapt', 'CmtGetFlag', CmtGetFlag);
 
      WriteString('Dcad', 'LispFileName', LspFileName);
      WriteString('Dcad', 'LispCmdName', LspCmdName);
      WriteString('Dcad', 'LispCommand', LspCommand);
    end;
  finally
    ini.Free;
  end;
end;
 
// ***************************
// フォームリサイズ
// ***************************
procedure TForm2.FormResize(Sender: TObject);
var
  n, xcnt, ycnt:Integer;
begin
  n := Length(BmpAry);
  if n > 0 then begin
    with DrawGrid1 do begin
      xcnt := (Width - 23) div DefaultColWidth;
      if xcnt=0 then xcnt:=1;
      ycnt := n div xcnt;
      if n mod xcnt > 0 then Inc(ycnt);
      ColCount := xcnt;
      RowCount := ycnt;
    end;
  end;
end;
 
procedure TForm2.N2Click(Sender: TObject);
begin
end;
 
// ************************************
// 設定フォーム
// ************************************
procedure TForm2.N3Click(Sender: TObject);
begin
  Form3 := TForm3.Create(Form2);
  with Form3 do begin
    try
      Edit1.Text := BlkName1;
      Edit2.Text := AttName1;
      Edit3.Text := BlkName2;
      Edit4.Text := AttName2;
      Edit5.Text := BmpW.ToString;
      Edit6.Text := BmpH.ToString;
      Edit7.Text := TitleH1.ToString;
      Edit8.Text := TitleH2.ToString;
 
      CheckBox1.Checked := AttFlag1;
      CheckBox2.Checked := AttFlag2;
      CheckBox4.Checked := BcadActiveFlag;
 
      CheckBox3.Checked := CmtGetFlag;
      CheckBox5.Checked := CmtDispFlag;
 
      Edit9.Text := LspFileName;
      Edit10.Text := LspCommand;
      Edit11.Text := LspCmdName;
 
 
      if ShowModal = mrOk then begin
        BlkName1 := Edit1.Text;
        AttName1 := Edit2.Text;
        BlkName2 := Edit3.Text;
        AttName2 := Edit4.Text;
 
        BmpW := StrToIntDef(Edit5.Text, BmpW);
        BmpH := StrToIntDef(Edit6.Text, BmpH);
        TitleH1 := StrToIntDef(Edit7.Text, TitleH1);
        TitleH2 := StrToIntDef(Edit8.Text, TitleH2);
 
        AttFlag1 := CheckBox1.Checked;
        if AttFlag1 and (BlkName1 <> '') and (AttName1 <> '') then begin
          BlkName := BlkName1;
          AttName := AttName1;
        end;
        AttFlag2 := CheckBox2.Checked;
        if AttFlag2 and (BlkName2 <> '') and (AttName2 <> '') then begin
          BlkName := BlkName2;
          AttName := AttName2;
        end;
 
        BcadActiveFlag := CheckBox4.Checked;
 
        CmtGetFlag := CheckBox3.Checked;
        CmtDispFlag := CheckBox5.Checked;
 
        LspFileName := Edit9.Text;
        LspCommand := Edit10.Text;
        LspCmdName := Edit11.Text;
 
        // メニュー
        N2.Caption := LspCmdName;
        SpeedButton2.Caption := LspCmdName;
 
      end;
    finally
      Free;
    end;
  end;
end;
 
// ************************************
// DXFファイルからシステム変数（2D座標）を取得する
// ************************************
function ReadDxfVariablePoint2D(dxfSl: TStrings; const sysName: string):string;
var
  idx, i : integer;
  code : integer;
  s : string;
  dxfSys : string;
begin
  Result := '';
 
  dxfSys := '$' + Uppercase(sysName);
 
  idx := dxfSL.IndexOf('ENTITIES');
  for i := 0 to idx div 2 do begin
    code := StrToInt(dxfSl[i *2]);
    s := dxfSl[i * 2 + 1];
    if (code = 9) and (s = dxfSys) then begin
      result := dxfSl[(i + 1) * 2 + 1]  + ',' +  dxfSl[(i + 2) * 2 + 1];
      break;
    end;
  end;
end;
 
// ************************************
// DXFファイルから属性を取得する
// ************************************
function ReadDxfAttRib(dxfSl: TStrings; const InsertName: string; const AttRibName: string): string;
var
  i : integer;
  insFlag, attFlag, hasAtt : boolean;
  s : string;
  AblkName , AattName, AattString : string;
  code, idx : integer;
begin
  Result := '';
  insFlag := False;
  hasAtt  := False;
  attFlag := False;
 
  // ENTITIESセクションを探す
  idx := dxfsl.IndexOf('ENTITIES');
 
  for i := idx div 2 + 1 to dxfsl.Count div 2 - 1 do begin
    // DXFコード
    code := StrToInt(dxfsl[i * 2]);
    // その値
    s := dxfsl[i * 2 + 1];
 
    if insFlag then begin
 
      // 属性取得終了
      if hasAtt and (code = 0) and (s = 'SEQEND') then begin
        insFlag := False;
        hasAtt  := False;
        attFlag := false;
      end;
 
      if hasAtt and (AblkName = '') and (code = 2) then
        AblkName := s;
 
      if attFlag then begin
        // 属性の値を保持
        if code = 1 then
          AattString := s;
        // 属性名
        if code = 2 then begin
          AattName := s;
          // ブロック名、属性名が同じ
          if (InsertName = ABlkName) and (AttRibName = AattName) then begin
            Result := AattString;
            Break;
          end;
        end;
      end;
      if hasAtt and (code = 0) and (s = 'ATTRIB') then
        attFlag := True;
    end;
 
    if (code = 0) and (s = 'INSERT') then begin
      insFlag := True;
      hasAtt  := False;
      attFlag := False;
      AblkName := '';
    end;
    // 属性有
    if (code = 66) and (Trim(s) = '1') then
      hasAtt := True;
    // ENTITIES セクション終わり
    if (code = 0) and (s = 'ENDSEC') then
      Break;
  end;
 
end;
 
// ************************************
// DXFファイルを作成する
// ************************************
function SaveDxfSl(dxfsl : TStringList):boolean;
var
  fname : TFileName;
  cnt : integer;
begin
  Result := False;
  fname := ChangeFileExt(ParamStr(0), '.dxf');
 
  DeleteFile(fname);
  cnt := 0;
  while True do begin
    Sleep(10);
    if not FileExists(fname) then begin
      Break;
    end;
    Inc(cnt);
    if cnt > 5 then Break;
  end;
 
  if SetDcadActive then begin
    SendDcadCommand(#3'FILEDIA'#13'0'#13);
    Sleep(10);
    SendDcadCommand('DXFOUT'#13 + fname + #13'Vesion'#13'R18'#13'16'#13);
    SendDcadCommand('''FILEDIA'#13'1'#13);
    cnt := 0;
 
    while True do begin
      Sleep(10);
      if FileExists(fname) then begin
        Sleep(10);
        Break;
      end;
      Inc(cnt);
      if cnt > 50 then Break;
    end;
    if FileExists(fname) then begin
      dxfsl.LoadFromFile(fname);
      Result := dxfsl.Count > 0;
    end;
  end;
end;
 
// ************************************
// 再キャプチャ
// ************************************
procedure TForm2.N5Click(Sender: TObject);
var
  i, idx, j : integer;
  ACol, ARow :integer;
  s, s1 : string;
  n : integer;
  scrW, scrH : Integer;
  ARect : TREct;
  ALeft, ATop : integer;
  scale : Double;
  APoint : TPoint;
begin
  with DrawGrid1 do begin
 
    // マウス座標をCol,Rowに
    MouseToCell(MoveX, MoveY, ACol, ARow);
    Row := ARow;
    Col := ACol;
    i := Row * ColCount + Col;
    if (i >= 0) and (i < Length(DwgDocAry)) then begin
      idx := DwgDocAry[i].Index;
 
      if GetDCadMainWinHandle = 0 then Exit;
 
      // MDI のウィンドウを探す
      GetDcadMDIClientHandle;
 
      SetForegroundWindow(DcadMainWinHandle);
 
      // メニュー操作
      keybd_event(VK_MENU, 0, 0, 0);
      keybd_event(Ord('W'), 0, 0, 0);
      keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
      keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
 
      for j := 0 to idx + 4 do begin
        keybd_event(VK_DOWN, 0 ,0 ,0);
        keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
      end;
 
      keybd_event(VK_RETURN, 0, 0, 0);
      keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
 
      ComboBox1.ItemIndex := i;
 
      Sleep(500);
 
      // ウィンドウの位置と大きさを取得
      GetWindowRect(DcadMDIClientWinHandle, ARect);
 
      // グラフィックウィンドウの左上座標
      ALeft := ARect.Left;
      ATop  := ARect.Top;
 
      // cad からグラフィック画面のサイズを取得
      s := GetDcadVariable('SCREENSIZE');
      n := Pos(',', s);
      scrW := Trunc(StrToFloatDef(Copy(s, 1, n -1), 0));
      scrH := Trunc(StrToFloatDef(Copy(s, n + 1  ), 0));
 
      // システム変数取得失敗であれば、終了
      if (scrW = 0) or (scrH = 0) then Exit;
 
      // 高解像度DPI対策
      ALeft := Trunc(ALeft * scrW / (ARect.Right  - ARect.Left));
      ATop  := Trunc(ATop  * scrH / (ARect.Bottom - ARect.Top));
 
      // キャプチャするビットマップの大きさに縮小する尺度
      if BmpH / BmpW < scrH / scrW then
        scale := BmpW / scrW
      else
        scale := BmpH / scrH;
      //
      SetCursorPos(ALeft + 1, ATop + 1);
 
      // 図面範囲でズーム
      s1 := GetDcadVariable('LIMMAX');
      s  := GetDcadVariable('LIMMIN');
 
      if (s <> '') and (s1 <> '') then begin
        SendDcadCommand('ZOOM'#13 + s + #13 + s1 + #13);
      end
      else begin
        SendDcadCommand('ZOOM'#13'Fit'#13);
      end;
      Sleep(200);
 
      SendDcadCommand('ZOOM'#13 + Format('%.3f', [scale]) + 'X'#13);
 
      // 描画待ち
      Sleep(500);
 
      if Length(BmpAry) > idx then begin
        // キャプチャ
        CaptureToBmp(
          ALeft + (scrW - BmpW) div 2,
          ATop  + (scrH - BmpH) div 2,
          BmpAry[idx].Width, BmpAry[idx].Height, BmpAry[idx]);
      end;
 
      // 直前の画面表示に戻す
      SendDcadCommand('ZOOM'#13'P'#13);
 
      // マウスカーソルを戻す
      APoint.X := MoveX;
      APoint.Y := MoveY;
      APoint := ClientToScreen(APoint);
      SetCursorPos(APoint.X, APoint.Y);
 
      Repaint;
    end;
  end;
end;
 
// ***********************************
// 画面キャプチャ
// ***********************************
procedure TForm2.SpeedButton1Click(Sender: TObject);
var
  limmax, limmin : OleVariant;
  scrH, scrW : integer;
  ARect : TRect;
  ALeft, ATop, AWidth, AHeight : integer;
  i : integer;
  scale : double;
  h, hdwg : HWND;
  dwgTitle, ext : string;
  cnt : integer;
  s, s1 : string;
  n, j :integer;
  Tics : Cardinal;
  sl : TStringList;
  Title : string;
  count : integer;
begin
  Tics := GetTickCount;
  // メインウィンドウのハンドルを取得
  if GetDCadMainWinHandle = 0 then Exit;
 
  // 最小化されていれば戻す
  if isIconic(DcadMainWinHandle) then begin
    OpenIcon(DcadMainWinHandle);
    Sleep(100);
  end;
 
  // MDI のウィンドウを探す
  GetDcadMDIClientHandle;
  h := DcadMDIChildWinHandle;
  cnt := 0;
 
  // ここでは、ドキュメントの数を数えるだけ
  while h <> 0 do begin
    hdwg := GetWindow(h, GW_CHILD);
    dwgTitle := GetWindowCaption(hdwg);
    // ファイル名を取得
    ext := Uppercase(ExtRactFileExt(dwgTitle));
 
    // 念のため、拡張子を比較
    if (ext = '.DWG') or (ext = '.DWG*') then
      Inc(cnt);
 
    // 次のウィンドウを探す
    h := GetWindow(h, GW_HWNDNEXT);
  end;
  if cnt = 0 then Exit;
 
  // ウィンドウの位置と大きさを取得
  GetWindowRect(DcadMDIClientWinHandle, ARect);
 
  // グラフィックウィンドウの左上座標
  ALeft := ARect.Left;
  ATop := ARect.Top;
 
  SetCursorPos(ALeft + 1, ATop + 1);
 
  AWidth := ARect.Right - ARect.Left;
  AHeight := ARect.Bottom - ARect.Top;
 
  // Draftsight からグラフィック画面のサイズを取得
  s := GetDcadVariable('SCREENSIZE');
  n := Pos(',', s);
  scrW := Trunc(StrToFloatDef(Copy(s, 1, n -1), 0));
  scrH := Trunc(StrToFloatDef(Copy(s, n + 1), 0));
 
  // 高解像度DPI対策
  ALeft := Trunc(ALeft * scrW / AWidth);
  ATop := Trunc(ATop * scrH / AHeight);
 
  // キャプチャするビットマップの大きさに縮小
  if BmpH / BmpW < scrH / scrW then
    scale := BmpW / scrW
  else
    scale := BmpH / scrH;
 
  // 自フォームを最小に
  //WindowState := wsMinimized;
  //Sleep(100);
 
  // すでにBitmap が作成されているときは、破棄
  if Length(BmpAry) > 0 then begin
    for i := 0 to Length(BmpAry) -1 do
      BmpAry[i].Free;
  end;
 
 
  SetLength(BmpAry, cnt);
  SetLength(DwgDocAry, cnt);
 
  with DrawGrid1 do begin
    // 適当な大きさを確保
    RowCount := cnt div ColCount;
    if cnt mod ColCount > 0 then RowCount := RowCount + 1;
  end;
 
  SetForegroundWindow(DcadMainWinHandle);
  sl := TStringList.Create;
  try
    Title := '';
    // メニューを操作
    for i := 0 to cnt - 1 do begin
 
      keybd_event(VK_MENU, 0, 0, 0);
      keybd_event(Ord('W'), 0, 0, 0);
      keybd_event(Ord('W'), 0, KEYEVENTF_KEYUP, 0);
      keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
 
      for j := 0 to i + 4 do begin
        keybd_event(VK_DOWN, 0 ,0 ,0);
        keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
      end;
 
      keybd_event(VK_RETURN, 0, 0, 0);
      keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0);
 
      count := 0;
      while True do begin
        Sleep(10);
        if Title <> GetWindowCaption(DcadMainWinHandle) then begin
          Break;
        end;
        Inc(count);
        if Count > 60 then Break;
      end;
 
      // 図面切り替わり待ち
      Sleep((count+2) * 50);
 
      // 編集の図面名を取得
      s := GetWindowCaption(DcadMainWinHandle);
      Title := s;
      // 配列に格納
      with DwgDocAry[i] do begin
        Index := i;
        Name := StrAfterStrBefore('[', ']', s);
      end;
 
      if SaveDxfSL(sl) then begin
        // シート番号、またはページ番号を取得
        s := ReadDxfAttRib(sl, BlkName, AttName);
        DwgDocAry[i].Comment := s;
 
        s  := ReadDxfVariablePoint2D(sl, 'LIMMAX');
        s1 := ReadDxfVariablePoint2D(sl, 'LIMMIN');
 
        SendDcadCommand('ZOOM'#13 + s + #13 + s1 + #13);
      end
      else begin
        SendDcadCommand('ZOOM'#13'F'#13);
        DwgDocAry[i].Comment := '';
      end;
 
      SendDcadCommand('ZOOM'#13 + Format('%.3f', [scale]) + 'X'#13);
      Sleep(200);
 
      // キャプチャ用ビットマップを作成
      BmpAry[i] := TBitmap.Create;
      BmpAry[i].PixelFormat := pf32bit;
 
      // ビットマップの大きさ
      BmpAry[i].Width := BmpW;
      BmpAry[i].Height := BmpH;
 
      // キャプチャ
      CaptureToBmp(
        ALeft + (scrW - BmpW) div 2,
        ATop  + (scrH - BmpH) div 2,
        BmpAry[i].Width, BmpAry[i].Height, BmpAry[i]);
 
      SendDcadCommand('ZOOM'#13'P'#13);
      Sleep(200);
 
 
    end;
  finally
    sl.Free;
  end;
 
 
  // シート番号、ページ番号順にソート
  SortDwgDocAry;
 
  with ComboBox1 do begin
    Items.Clear;
    Sorted := False;
    for i := 0 to Length(DwgDocAry) - 1 do
      Items.AddObject(DwgDocAry[i].Comment +':'+ DwgDocAry[i].Name , TObject(i));
  end;
 
  FormResize(self);
  ComboBox1Change(self);
 
  // 自フォームを戻す
  //WindowState := wsNormal;
 
  // 自フォームをアクティブに
  SetForegroundWindow(Handle);
  ShowMessage('終了しました。'+#13#10 +
    Format('%.1f',[(GetTickCount - Tics) / 1000]) + '秒');
 
end;
 
procedure TForm2.SpeedButton2Click(Sender: TObject);
begin
  // コマンド実行
  N2Click(self);
end;
 
procedure TForm2.SpeedButton3Click(Sender: TObject);
begin
  // 設定
  N3Click(self);
end;
 
procedure TForm2.SpeedButton4Click(Sender: TObject);
var
  s:string;
begin
  s := GetDcadVariable(Edit1.Text);
  ShowMessage(s);
 
end;
 
end.