DcadPlot Ver.2015.5.4 for DraftSight / ARES commander
※ARES は廉価版でも COM API (ActiveX) が使えます。そちらを使ったほうがスマートです。
■概要
DraftSight / ARES で開いている図面を一括で印刷ツールです。
図面の取得、印刷には、結構時間がかかります。
図枠に属性として、シート番号、ページ番号が設定されている場合は、その順で出力できます。
※印刷設定ファイル（PrintStyle）の取得は、システム変数 FONTMAP （フォントマップファイル）のフォルダ名から推定しています。
システム変数 FONTMAP の値が書き変わってしまった場合は、下記を参考に設定しなおして下さい。
DraftSight
"C:\Program Files\Dassault Systemes\DraftSight\Fonts\fonts.fmp"
ARES
"C:\Program Files\Graebert GmbH\ARES Commander 2015\Fonts\fonts.fmp"
（32bit版の時は、Program Files (x86) になります）
※印刷時間は、長めに設定して下さい。印刷中にドキュメントが切り替わると、ＣＡＤがエラーで継続不能になります。
※印刷待ちに、コマンドラインをキャプチャし、画像の変化による監視を追加しました。「設定」タブにて使えるかどうか確認できます。
コマンドラインが隠れるとうまく動きませんので、注意して下さい。
こちらの環境では、exe のプロパティ「互換」で、「高解像度DPI...」にチェックを付ける必要がありました。
やはり、「バッチ印刷」を使ったほうが、安全で快適なのだと思います。
■履歴
2015/04/26
・初版作成
2015/04/30
・DXFファイルから属性（シート番号、ページ番号）の取得を追加
2015/05/03
・コマンド送信に、[Enter]、[ESC] を追加。取得を若干高速にした。
2015/05/04
・印刷待ちに、キャプチャ画像によるコマンドライン監視を追加。取得を若干高速にした。
・自動保存を一時的にOFFにするを追加した。
■ダウンロード
DcadPlot.zip (2015/05/04 exe本体のみ）
■ソースコード
unit DcadPlotUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.CheckLst,Comobj, Vcl.ExtCtrls, Vcl.Grids, IniFiles, System.UITypes,
Vcl.ComCtrls, Vcl.Buttons, ClipBrd, Imm, Printers, Winspool, System.IOUtils, System.Types;
type
DcadPoint = array [0..2] of double;
type
TForm5 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Button1: TButton;
SpeedButton4: TSpeedButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Button2: TButton;
Button4: TButton;
Label3: TLabel;
Edit1: TEdit;
StringGrid1: TStringGrid;
ProgressBar1: TProgressBar;
Label6: TLabel;
ComboBox3: TComboBox;
Label8: TLabel;
SpeedButton9: TSpeedButton;
Label17: TLabel;
SpeedButton3: TSpeedButton;
TabSheet2: TTabSheet;
GroupBox2: TGroupBox;
Label7: TLabel;
Edit2: TEdit;
Label9: TLabel;
Label10: TLabel;
Edit3: TEdit;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Edit4: TEdit;
Label15: TLabel;
GroupBox3: TGroupBox;
Label16: TLabel;
Edit5: TEdit;
Edit6: TEdit;
Label18: TLabel;
Edit7: TEdit;
Edit8: TEdit;
Label19: TLabel;
Label20: TLabel;
SpeedButton5: TSpeedButton;
Image1: TImage;
SpeedButton6: TSpeedButton;
Image2: TImage;
CheckBox1: TCheckBox;
Label21: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
private
{ Private 宣言 }
LastPrinter, LastCtbStb :string;
MbRow, MbCol : integer;
public
{ Public 宣言 }
RunFlag : boolean;
procedure DispCheckedCount;
end;
var
Form5: TForm5;
// メインウィンドウ
DcadMainWinHandle : HWND;
DcadMDIClientWinHandle : HWND;
DcadCommandWinHandle : HWND;
DcadInputWinHandle : HWND;
DcadOutputWinHandle : HWND;
DcadMDIActiveWinHandle : HWND;
DcadMDIChildWinHandle : HWND;
DCadProcessID : DWORD; //プロセスID
SleepDocChg, SleepPrint, SleepSysVar : integer;
// *****************************
// プリンター用紙名を取得
// *****************************
procedure GetPrinterPaperNames(iIndex :integer; sl: TStrings);
implementation
{$R *.dfm}
//****************************************
// 画面の指定位置を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;
//****************************************
// 最後の指定文字列より後を得る
//****************************************
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;
//****************************************
// 実際には、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ではない
//****************************************
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;
//****************************************
// コマンドウィンドウ Input/OutputWindow
//****************************************
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 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;
//****************************************
// 文字列送信
//****************************************
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 GetWindowCaption(h : HWND) : string;
var
Title : array [0..255] of char;
begin
result := '';
if GetWindowText(h, Title, 255) <> 0 then
result := Title;
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;
//****************************************
// DraftSight / ARES commander をアクティブに
//****************************************
function SetDcadActive: boolean;
begin
Result := False;
if GetDCadMainWinHandle <> 0 then begin
SetForegroundWindow(DcadMainWinHandle);
Result := True;
end;
end;
function WaitForDcadCommandReady(timeout: integer): boolean;
var
cnt : integer;
ARect : TRect;
AHeight,ATop : integer;
Bmp : TBitMap;
co : Integer;
i,j: integer;
pByte :PByteArray;
Flag : Boolean;
msec : integer;
n : integer;
begin
Result := False;
msec := 10;
GetDcadMainWinHandle;
GetDcadCommandWinHandle;
//Form5.Caption := IntToHex(DcadInputWinHandle, 8);
GetWindowRect(DcadInputWinHandle, ARect);
ATop := ARect.Top;
AHeight := ARect.Bottom - ARect.Top;
ATop := ATop+ AHeight -20;
//AWidth := ARect.Right - Arect.Left;
//Form5.Caption := IntToStr(AHeight);
Bmp := TBitmap.Create;
try
Bmp.Width := 100;
Bmp.Height := 20;
Bmp.PixelFormat :=pf24bit;
n := 0;
cnt := 0;
while True do begin
Sleep(msec);
Application.ProcessMessages;
CaptureToBmp(Arect.Left + 18, ATop, Bmp.Width, Bmp.Height, bmp);
Form5.Image1.Picture.Assign(bmp);
pByte := Bmp.ScanLine[0];
co := pByte[0];
Flag := True;
for i := 1 to Bmp.Height - 1 do begin
pByte := Bmp.ScanLine[i];
for j := 0 to Bmp.Width -1 do begin
if co <> pByte[j] then begin
Flag := False;
n := 0;
Break;
end;
end;
end;
if Flag then Inc(n);
if n > 3 then begin
Result := True;
Break;
end;
Inc(cnt);
if cnt * msec > timeout then Break;
end;
finally
Bmp.Free;
end;
end;
//****************************************
// 座標文字列を3D座標に
//****************************************
procedure StrPointToDcadPoint(const StrPoint: string; var pt: DcadPoint);
var
n : integer;
s: string;
begin
s := StrPoint;
n := Pos(',', s);
pt[0] := StrToFloatDef(Copy(s, 1, n - 1), 0);
s := Copy(s, n + 1);
n := Pos(',', s);
if n > 0 then begin
pt[1] := StrToFloatDef(Copy(s, 1, n - 1), 0);
pt[2] := StrToFloatDef(Copy(s, n + 1), 0);
end
else begin
pt[1] := StrToFloatDef(s, 0);
pt[2] := 0;
end;
end;
// ************************************
// DXFファイルからシステム変数（2D座標）を取得する
// ************************************
function ReadDxfVariablePoint2DString(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('FILEDIA'#13'0'#13);
Sleep(10);
SendDcadCommand('DXFOUT'#13 + fname +#13'Vesion'#13'R18'#13'16'#13);
Sleep(10);
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 TForm5.DispCheckedCount;
var
i, cnt : integer;
begin
cnt := 0;
with StringGrid1 do begin
for i := 1 to RowCount - 1 do begin
if (Cells[1, i] <> '') and Bool(Objects[1, i]) then Inc(cnt);
end;
end;
// 印刷ボタン
Button2.Enabled := cnt > 0;
Label5.Caption := IntToStr(cnt);
end;
// *****************************
// StringGrid でのキー操作
// *****************************
procedure SgKeyDown(SG: TSTringGrid; var Key: Word; Shift:TShiftState);
var
i, j, k, n : integer;
sl : TStringList;
s, s1 : string;
xflag : boolean;
begin
if Key = VK_DELETE then begin
with SG do begin
if (Selection.Top <> Selection.Bottom) or
(Selection.Left <> Selection.Right) then begin
Key := 0;
for i := Selection.Top to Selection.Bottom do begin
for j := Selection.Left to Selection.Right do begin
Cells[j, i] := '';
end;
end;
end;
end;
end;
if ssCtrl in Shift then begin
if true then begin
xflag := (Key = Ord('X')) or (Key = Ord('x'));
if (Key = Ord('C')) or (Key = Ord('c')) or xflag then begin
Key := 0;
Clipboard.AsText := '';
with SG do begin
for i := Selection.Top to Selection.Bottom do begin
for j := Selection.Left to Selection.Right do begin
Clipboard.AsText := Clipboard.AsText + Cells[j, i];
if j < Selection.Right then Clipboard.AsText := Clipboard.AsText + #9
else Clipboard.AsText := Clipboard.AsText + #13#10;
end;
end;
if xflag then begin
for i := Selection.Top to Selection.Bottom do begin
for j := Selection.Left to Selection.Right do begin
Cells[j, i] := '';
end;
end;
end;
end;
end
else if (Key = Ord('V')) or (Key = Ord('v')) then begin
//with SG do
// if EditorMode then EditorMode := false;
Key := 0;
with SG do begin
sl := TStringList.Create;
try
s := Clipboard.AsText;
while true do begin
k := Pos(#13#10, s);
if k = 0 then break
else begin
sl.Add(Copy(s, 1, k - 1));
Delete(s, 1, k + 1);
end;
end;
for i := 0 to sl.Count-1 do begin
s := SL[i];
j := 0;
while true do begin
k := Pos(#9, s);
if k = 0 then begin
s1 := Copy(s, 1, Length(s));
end
else begin
s1 := Copy(s, 1, k - 1);
Delete(s, 1, k);
end;
Cells[Selection.Left + j,Selection.Top + i] := s1;
n := 1;
while true do begin
if Selection.Bottom < Selection.Top + i + (sl.Count * n) then
break
else begin
Cells[Selection.Left + j, Selection.Top + i + (sl.Count * n)] := s1;
end;
Inc(n);
end;
if k = 0 then break;
Inc(j);
end;
end;
finally
sl.Free;
end;
end;
end;
end;
end;
end;
// *****************************
// StringGrid の Col の値でソート
// *****************************
procedure SgSortByCol2(sg : TStringGrid; col1, col2 :integer; NumFlag:boolean);
var
i, j : integer;
sl, sltemp : TStringList;
s1, s0 : string;
begin
// ソート
sl := TStringList.Create;
try
sltemp := TStringList.Create;
try
with sg do begin
for i := 1 to RowCount -2 do begin
s0 := '';
if col1 >= 0 then s0 := s0 + Cells[col1, i];
if col2 >= 0 then s0 := s0 + Cells[col2, i];
for j := i + 1 to RowCount -1 do begin
s1 := '';
if col1 >= 0 then s1 := s1 + Cells[col1, j];
if col2 >= 0 then s1 := s1 + Cells[col2, j];
if (not NumFlag and (s0 > s1)) or
(NumFlag and (StrToIntDef(s0, 0) > StrToIntDef(s1, 0))) then begin
slTemp.Assign(Rows[i]);
Rows[i] := Rows[j];
Rows[j] := slTemp;
s0 := s1;
end;
end;
end;
end;
finally
slTemp.Free;
end;
finally
sl.Free;
end;
end;
// *****************************
// 取得
// *****************************
procedure TForm5.Button1Click(Sender: TObject);
var
i : integer;
sdir : string;
cnt : integer;
j : integer;
s :string;
arycnt : integer;
dwgname , dwgprefix :string;
limmax, limmin : DcadPoint;
h, hdwg : HWND;
dwgTitle, ext : string;
fnames: TStringDynArray;
fpath, fname : TFileName;
sl : TStringList;
Title : string;
count : integer;
begin
Title := '';
// メニューを操作して図面を切り替えるため、
// 一度図面を切り替えて、そのファイル名を取得して記憶する
// メインウィンドウのハンドルを取得
if GetDCadMainWinHandle = 0 then Exit;
// 最小化されていれば戻す
if isIconic(DcadMainWinHandle) then begin
OpenIcon(DcadMainWinHandle);
// 画面描画待ち
Sleep(SleepDocChg);
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;
SendDcadCommand(#3'SAVETIME'#13'0'#13);
sdir := GetDcadVariable('DWGPREFIX');
Edit1.Text := sdir;
arycnt := cnt;
if arycnt > 0 then begin
with Progressbar1 do begin
Max := arycnt;
Position := 0;
end;
with StringGrid1 do begin
RowCount := arycnt + 1;
for i := 1 to RowCount -1 do
for j := 0 to ColCount -1 do
Cells[j, i] := '';
end;
cnt := 0;
sl := TStringList.Create;
try
// メニューを操作
for i := 0 to arycnt - 1 do begin
// CADをアクティブに
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 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;
dwgname := StrAfterStrBefore('[', ']', s);
dwgprefix := GetDcadVariable('DWGPREFIX');
// 同じフォルダ名の図面のみを取得
if sdir = dwgprefix then begin
with StringGrid1 do begin
Cells[0, cnt + 1] := IntToStr(i + 1);
Cells[1, cnt + 1] := dwgname;
if SaveDxfSL(sl) then begin
// シート番号を取得
s := ReadDxfAttRib(sl, Edit5.Text, Edit6.Text);
Cells[7, cnt + 1] := s;
//ページ番号を取得
s := ReadDxfAttRib(sl, Edit7.Text, Edit8.Text);
Cells[8, cnt + 1] := s;
s := ReadDxfVariablePoint2DString(sl, 'LIMMAX');
Cells[9, cnt + 1] := s;
StrPointToDcadPoint(s, limmax);
s := ReadDxfVariablePoint2DString(sl, 'LIMMIN');
Cells[10, cnt + 1] := s;
StrPointToDcadPoint(s, limmin);
Cells[2, cnt + 1] := Format('%.1f',[limmax[0] - limmin[0]]);
Cells[3, cnt + 1] := Format('%.1f',[limmax[1] - limmin[1]]);
// ScaleA3
Cells[4, cnt + 1] := Format('%.3f',[limmax[0] / 420]);
// ScaleA4
Cells[5, cnt + 1] := Format('%.3f',[limmax[0] / 297]);
Objects[1, cnt + 1] := TObject(True);
end;
end;
with Progressbar1 do Position := Position + 1;
Inc(cnt);
end;
end;
finally
sl.Free;
end;
with StringGrid1 do begin
RowCount := cnt + 1;
Row := 1;
Col := 2;
SetFocus;
end;
label6.Caption := '/' + cnt.ToString;
Progressbar1.Position := 0;
// プリンター名一覧を Windows から取得
ComboBox1.Items.Assign(Printer.Printers);
with ComboBox1 do begin
if LastPrinter <> '' then begin
for i := 0 to Items.Count - 1 do begin
if Items[i] = LastPrinter then begin
ItemIndex := i;
Break;
end;
end;
end
else begin
if Items.Count > 0 then
ItemIndex := 0
else
ItemIndex := - 1;
end;
end;
// 用紙名一覧を Windows から取得
GetPrinterPaperNames(ComboBox1.ItemIndex, ComboBox3.Items);
with ComboBox3 do begin
for i := 0 to Items.Count - 1 do begin
if Pos('A4', Items[i]) > 0 then begin
ItemIndex := i;
break;
end;
end;
end;
Sleep(SleepSysVar);
// PrintStyle をDraftShight / ARES commander のインストールフォルダから取得
// フォントマップファイルの保存先を取得
s := GetDcadVariable('FONTMAP');
fpath := ExtractFilePath(ExtractFileDir(s)) + 'Default Files\Print Styles\';
if DirectoryExists(fpath) then begin
fnames := TDirectory.GetFiles(fpath, '*.?tb', TSearchOption.soTopDirectoryOnly);
with ComboBox2 do begin
Items.Clear;
for fname in fnames do
Items.Add(ExtractFileName(fname));
ItemIndex := Items.IndexOf(LastCtbStb);
if (ItemIndex < 0) and (Items.Count > 0) then
ItemIndex := 0;
end;
end;
end;
SendDcadCommand(#3'SAVETIME'#13'10'#13);
DispCheckedCount;
// シート番号順
SpeedButton3Click(self);
end;
// *****************************
// プリンター用紙名を取得
// *****************************
procedure GetPrinterPaperNames(iIndex :integer; sl: TStrings);
type
//用紙名リスト用．用紙名の文字数の最大は64
TPaperName = array [0..63] of Char;
var
ADevice : array [0..MAX_PATH-1] of Char;
ADriver : array [0..MAX_PATH-1] of Char;
APort : array [0..MAX_PATH-1] of Char;
ADeviceMode : THandle;
Count : Integer;
PaperNames : array of TPaperName;
i : Integer;
begin
sl.Clear;
//選択したプリンタを現在のプリンタとする
Printer.PrinterIndex := iIndex;
//現在のプリンタに関する情報を取り出す
Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
//そのプリンタADeviceのAPortの用紙名の数を取得
Count := Winspool.DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, nil, nil);
//その分だけ用紙名配列の長さと用紙番号の配列の長さを確保
SetLength(PaperNames, Count);
//その配列に用紙名と用紙番号を取得
Winspool.DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, PChar(PaperNames), nil);
//用紙名
for i := 0 to Count - 1 do sl.Add(String(PaperNames[i]));
end;
// *****************************
// 印刷実行
// *****************************
procedure TForm5.Button2Click(Sender: TObject);
var
i, j : integer;
scale : string;
papersize: string;
idx : integer;
devname : string;
sl : TStringList;
fname : TFileName;
begin
fname := ChangeFileExt(ParamStr(0), '.scr');
LastCtbStb := 'monochrome.ctb';
if MessageDlg('選択ファイルを印刷しますか？', mtInformation,mbYesNo,0) = mrYes then begin
// 自動保存をOFF
SendDcadCommand(#3'SAVETIME'#13'0'#13);
with ComboBox1 do begin
if ItemIndex >= 0 then
LastPrinter := Items[ItemIndex]
else
LastPrinter := '';
end;
with ComboBox3 do begin
if ItemIndex >= 0 then
papersize := Items[ItemIndex]
else
papersize := 'A4';
end;
with ComboBox2 do begin
if ItemIndex >= 0 then
LastCtbStb := Items[ItemIndex]
else
LastCtbStb := '';
end;
if (LastPrinter <> '') and (LastCtbStb <> '') then begin
sl := TStringList.Create;
try
devname := LastPrinter;
RunFlag := True;
Button2.Enabled := False;
Button4.Enabled := True;
if True then begin
with StringGrid1 do begin
ProgressBar1.Max := RowCount - 1;
ProgressBar1.Position := 0;
for i := 1 to RowCount - 1 do begin
// A3 -> A4 縮小
if Pos('A4', papersize) > 0 then
scale := '1=' + Format('%.3f',[StrToFloat(Cells[5, i])])
// A3 -> A3
else
// papersize := 'A3';
scale := '1=' + Format('%.3f',[StrToFloat(Cells[4, i])]);
with Progressbar1 do Position := Position + 1;
Application.ProcessMessages;
if RunFlag and Bool(Objects[1, i]) then begin
idx := StrToInt(Cells[0, i]) - 1;
if GetDCadMainWinHandle <> 0 then begin
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);
// 図面切り替わり待ち
Sleep(SleepDocChg);
// スクリプトファイル作成
with sl do begin
Clear;
// コマンドラインプロット
Add('-PLOT');
// 印刷オプションの詳細設定?
Add('Y');
// シート名を指定»
Add('Model');
// プリンタ名を指定»
Add(devname);
Sleep(SleepSysVar);
// ペーパー サイズを指定»
Add(papersize);
// 単位を指定» インチ(I) または ミリメートル(M)
Add('M');
// 方向を指定>>縦(P) または 横(L)
Add('L');
// 上下を逆にして印刷しますか？
Add('Y');
// 印刷範囲を指定»
Add('S');
// 始点コーナーを指定»
Add(Cells[10, i]);
// 反対側のコーナーを指定»
Add(Cells[9, i]);
// 印刷尺度を指定»
Add(scale);
// 印刷 X,Y オフセットを指定»
Add('C');
// 印刷スタイル テーブルを使用?
Add('Y');
// 印刷スタイル名»
Add(LastCtbStb);
// 割り当てられた線幅を使用?
Add('Y');
// オプション指定»
// 表示どおり(D), 隠線(H), レンダリング(R) または ワイヤフレーム(W)
Add('D');
// ファイルに出力?
Add('N');
// 印刷設定をシートに適用?
Add('Y');
// 今すぐ印刷しますか?
Add('Y');
Add('FILEDIA 1');
SaveToFile(fname);
if FileExists(fname) then begin
SendDcadCommand('FILEDIA'#13'0'#13);
Sleep(10);
// スクリプト読込
SendDcadCommand('LOADSCRIPT'#13 + fname + #13);
end;
SetForeGroundWindow(DcadMainWinHandle);
// 印刷終了待ち
if SleepPrint < 5000 then SleepPrint := 5000;
if CheckBox1.Checked then begin
WaitForDcadCommandReady(SleepPrint);
Sleep(100);
end
else
Sleep(SleepPrint);
end;
end;
end;
end;
end;
end;
ProgressBar1.Position := 0;
if RunFlag then
ShowMessage('印刷が終了しました．')
else
ShowMessage('印刷を中止しました．');
Button2.Enabled := True;
Button4.Enabled := False;
finally
sl.Free;
end;
end;
SendDcadCommand(#3'SAVETIME'#13'10'#13);
end;
end;
// *****************************
// 中止ボタン
// *****************************
procedure TForm5.Button4Click(Sender: TObject);
begin
RunFlag := False;
Application.ProcessMessages;
end;
// *****************************
// プリンター変更
// *****************************
procedure TForm5.ComboBox1Change(Sender: TObject);
var
i : integer;
begin
with ComboBox1 do begin
if ItemIndex >= 0 then
LastPrinter := Items[ItemIndex];
end;
GetPrinterPaperNames(ComboBox1.ItemIndex, ComboBox3.Items);
ComboBox3.Sorted := True;
with ComboBox3 do begin
for i := 0 to Items.Count - 1 do begin
if Pos('A4', Items[i]) > 0 then begin
ItemIndex := i;
break;
end;
end;
end;
end;
// *****************************
// 印刷設定変更
// *****************************
procedure TForm5.ComboBox2Change(Sender: TObject);
begin
with ComboBox2 do begin
if ItemIndex >= 0 then
LastCtbStb := Items[ItemIndex];
end;
end;
// *****************************
// フォーム作成
// *****************************
procedure TForm5.FormCreate(Sender: TObject);
var
ini : TIniFile;
begin
PageControl1.ActivePageIndex := 0;
Edit1.Text := '';
//Caption := Application.Title;
with StringGrid1 do begin
RowCount := 2;
ColCount := 11;
ColWidths[0] := 30;
ColWidths[1] := 230;
ColWidths[2] := 50;
ColWidths[3] := 50;
ColWidths[4] := 50;
ColWidths[5] := 50;
ColWidths[6] := 0;
ColWidths[7] := 50;
ColWidths[8] := 50;
ColWidths[9] := -1;
ColWidths[10] := -1;
Cells[0, 0] := 'No.';
Cells[1, 0] := 'ファイル名';
Cells[2, 0] := 'Lim W';
Cells[3, 0] := 'Lim H';
Cells[4, 0] := 'at A3';
Cells[5, 0] := 'at A4';
Cells[6, 0] := 'FilePath';
Cells[7, 0] := 'SHEET';
Cells[8, 0] := 'PAGE';
Cells[9, 0] := 'LimMax';
Cells[10, 0] := 'LimMin';
end;
SleepDocChg := 500;
SleepPrint := 5000;
SleepSysVar := 100;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
with ini do begin
try
LastPrinter := ReadString('Plot', 'LastPrinter', '');
LastCtbStb := ReadString('Plot', 'LastCtbStb', '');
with StringGrid1 do
ColWidths[1] := ReadInteger('Form', 'FNameWidth', ColWidths[1] );
SleepDocChg := ReadInteger('Timer', 'SleepDocChg', SleepDocChg);
SleepPrint := ReadInteger('Timer', 'SleepPrint', SleepPrint);
SleepSysVar := ReadInteger('Timer', 'SleepSysVar', SleepSysVar);
Edit5.Text := ReadString('SheetAttRib', 'BlockName', Edit5.Text);
Edit6.Text := ReadString('SheetAttRib', 'AttName', Edit6.Text);
Edit7.Text := ReadString('PageNoAttRib', 'BlockName', Edit7.Text);
Edit8.Text := ReadString('PageNoAttRib', 'AttName', Edit8.Text);
CheckBox1.Checked := ReadBool('CheckBox', 'Uses CmdCapt', CheckBox1.Checked);
finally
Free;
end;
end;
// 待ちタイマー設定
Edit2.Text := SleepDocChg.ToString;
Edit3.Text := SleepPrint.ToString;
Edit4.Text := SleepSysVar.ToString;
end;
// *****************************
// フォーム破棄
// *****************************
procedure TForm5.FormDestroy(Sender: TObject);
var
ini : TIniFile;
begin
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
with ini do begin
try
WriteString('Plot', 'LastPrinter', LastPrinter);
WriteString('Plot', 'LastCtbStb', LastCtbStb);
WriteInteger('Form', 'FNameWidth', StringGrid1.ColWidths[1] );
WriteInteger('Timer', 'SleepDocChg', SleepDocChg);
WriteInteger('Timer', 'SleepPrint', SleepPrint);
WriteInteger('Timer', 'SleepSysVar', SleepSysVar);
WriteBool('CheckBox', 'Uses CmdCapt', CheckBox1.Checked);
WriteString('SheetAttRib', 'BlockName', Edit5.Text);
WriteString('SheetAttRib', 'AttName', Edit6.Text);
WriteString('PageNoAttRib', 'BlockName', Edit7.Text);
WriteString('PageNoAttRib', 'AttName', Edit8.Text);
finally
Free;
end;
end;
end;
// 待機タイマー設定
procedure TForm5.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex = 0 then begin
SleepDocChg := StrToIntDef(Edit2.Text, SleepDocChg);
SleepPrint := StrToIntDef(Edit3.Text, SleepPrint );
SleepSysVar := StrToIntDef(Edit4.Text, SleepSysVar);
end;
end;
// *****************************
// 印刷チェック「すべてＯＮ」
// *****************************
procedure TForm5.SpeedButton1Click(Sender: TObject);
var
i : integer;
begin
with StringGrid1 do begin
for i := 1 to RowCount -1 do
Objects[1, i] := TObject(True);
end;
DispCheckedCount;
end;
// *****************************
// 印刷チェック「すべてＯＦＦ」
// *****************************
procedure TForm5.SpeedButton2Click(Sender: TObject);
var
i : integer;
begin
with StringGrid1 do begin
for i := 1 to RowCount - 1 do
Objects[1, i] := TObject(False);
end;
DispCheckedCount;
end;
procedure TForm5.SpeedButton3Click(Sender: TObject);
begin
// シート番号順
SgSortByCol2(StringGrid1, 7, -11, False);
end;
// *****************************
// 印刷「ファイル名順」
// *****************************
procedure TForm5.SpeedButton4Click(Sender: TObject);
begin
// ソート
SgSortByCol2(StringGrid1, 6, 1, False);
end;
procedure TForm5.SpeedButton5Click(Sender: TObject);
begin
// ページ番号順ソート
SgSortByCol2(StringGrid1, 8, -1, True);
end;
procedure TForm5.SpeedButton6Click(Sender: TObject);
var
ARect : TREct;
ATop, AHeight: integer;
Bmp : TBitmap;
begin
GetDcadMainWinHandle;
GetDcadCommandWinHandle;
//Form5.Caption := IntToHex(DcadInputWinHandle, 8);
GetWindowRect(DcadInputWinHandle, ARect);
ATop := ARect.Top;
AHeight := ARect.Bottom - ARect.Top;
ATop := ATop+ AHeight -20;
Bmp := TBitmap.Create;
try
Bmp.Width := 100;
Bmp.Height := 20;
Bmp.PixelFormat :=pf24bit;
CaptureToBmp(Arect.Left, ATop, Bmp.Width, Bmp.Height, bmp);
Image2.Picture.Assign(Bmp);
finally
Bmp.Free;
end;
end;
// *****************************
// 印刷：取得順ソート
// *****************************
procedure TForm5.SpeedButton9Click(Sender: TObject);
begin
SgSortByCol2(StringGrid1, 0, - 1, True);
end;
// *****************************
// 印刷用StringGridクリック
// *****************************
procedure TForm5.StringGrid1Click(Sender: TObject);
var
idx ,j : integer;
begin
with StringGrid1 do begin
if Row > 0 then begin
idx := StrToIntDef(Cells[0, Row], - 1) - 1;
if GetDCadMainWinHandle <> 0 then begin
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);
end;
end;
end;
end;
// *****************************
// 印刷用StringGrid描画
// *****************************
procedure TForm5.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
TempRect : TRect;
BoxRect : TRect;
uState : Cardinal;
sg : TStringGrid;
begin
sg := TStringGrid(Sender);
TempRect := Rect;
if (ARow > (sg.FixedRows - 1)) and (ACol = 1) then begin
// 背景を消す
sg.Canvas.FillRect(Rect);
//チェックボックスのサイズを設定
BoxRect.Left := Rect.Left + 5;
BoxRect.Top := Rect.Top + 3;
BoxRect.Bottom := Rect.Bottom - 3;
BoxRect.Right := BoxRect.Left + (BoxRect.Bottom - BoxRect.Top);
Rect.Right := Rect.Bottom - Rect.Top;
TempRect.Left := TempRect.Left + (BoxRect.Right - BoxRect.Left) + 8;
TempRect.Top := TempRect.Top + 3;
//Objectsプロパティの値に応じてチェック状態を描画
if Bool(sg.Objects[ACol, ARow]) then begin
sg.Canvas.Font.Color := clWindowText;
uState := DFCS_BUTTONCHECK or DFCS_CHECKED;
end else begin
sg.Canvas.Font.Color := clRed;
uState := DFCS_BUTTONCHECK;
end;
DrawText(sg.Canvas.Handle,
PChar(sg.Cells[ACol,ARow]), - 1, TempRect, DT_LEFT or DT_SINGLELINE);
DrawFrameControl(sg.Canvas.Handle, BoxRect, DFC_BUTTON, uState);
end;
end;
// *****************************
// 印刷用StringGrid キー操作
// *****************************
procedure TForm5.StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
AColLeft : Integer;
ARowTop : Integer;
ARowBottom : Integer;
i : Integer;
ABool : Boolean;
sg : TStringGrid;
begin
sg := TStringGrid(Sender);
with sg do begin
if Key = VK_SPACE then begin
//選択中のセルの範囲を調査
AColLeft := Selection.Left;
ARowTop := Selection.Top;
ARowBottom := Selection.Bottom;
//複数行選択に対応
if AColLeft = 1 then begin
for i := ARowTop to ARowBottom do begin
if Cells[AColLeft, i] <> '' then begin
ABool := Bool(Objects[AColLeft, i]);
Objects[AColLeft, i] := TObject(not ABool);
end;
end;
DispCheckedCount;
end;
end;
end;
end;
// *****************************
// 印刷用StringGrid マウス操作
// *****************************
procedure TForm5.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol : Integer;
ARow : Integer;
ABool : Boolean;
sg : TStringGrid;
begin
sg := TStringGrid(Sender);
with sg do begin
if Button = mbLeft then begin
MouseToCell(X, Y, ACol, ARow);
// ダブルクリックのために記憶
MbRow := ARow;
MbCol := ACol;
if (ARow > (FixedRows - 1)) and (ACol = 1) then begin
if Cells[ACol,ARow] <> '' then begin
ABool := Bool(Objects[ACol, ARow]);
Objects[ACol, ARow] := TObject(not ABool);
DispCheckedCount;
end;
end;
end;
end;
end;
end.