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.