// 2017/08/19 プロットスタイル CTB, STB 一覧で最後が取得できないのを手直し
// 2019/01/03 プロットコンフィグの取得が間違っていたのを手直し
unit BcadPlotUnit;
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.CheckLst,Comobj, Vcl.ExtCtrls, Vcl.Grids, IniFiles, System.UITypes,
Vcl.ComCtrls, Vcl.Buttons, ClipBrd, Imm, Printers, Winspool;
type
//BcadPt = array [0..2] of double;
TBcadAtt = record
BlkName : string;
TagName : string;
TxtStr : string;
colwidth : integer;
ImeFlag : boolean;
chkFlag : boolean;
end;
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;
TabSheet2: TTabSheet;
StringGrid2: TStringGrid;
ProgressBar1: TProgressBar;
Button7: TButton;
Label6: TLabel;
Edit2: TEdit;
SpeedButton5: TSpeedButton;
Label7: TLabel;
ComboBox3: TComboBox;
Label8: TLabel;
CheckBox1: TCheckBox;
TabSheet4: TTabSheet;
StringGrid4: TStringGrid;
GroupBox2: TGroupBox;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit3: TEdit;
GroupBox3: TGroupBox;
Label13: TLabel;
Label14: TLabel;
Edit7: TEdit;
Edit8: TEdit;
Label15: TLabel;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
SpeedButton11: TSpeedButton;
SpeedButton12: TSpeedButton;
Label16: TLabel;
Label17: TLabel;
SpeedButton13: TSpeedButton;
Button3: TButton;
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 Button7Click(Sender: TObject);
procedure StringGrid2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure StringGrid2Click(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure SpeedButton11Click(Sender: TObject);
procedure SpeedButton12Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton13Click(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
private
{ Private 宣言 }
LastPrinter, LastCtbStb :string;
MbRow, MbCol : integer;
public
{ Public 宣言 }
RunFlag : boolean;
procedure DispCheckedCount;
end;
var
Form5: TForm5;
BcadAttAry : array of TBcadAtt;
// *****************************
// プリンター用紙名を取得
// *****************************
procedure GetPrinterPaperNames(iIndex :integer; sl: TStrings);
implementation
{$R *.dfm}
// *****************************
// 印刷チェック数をカウント
// *****************************
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;
// *****************************
// Bricscad のドキュメントから属性を取得
// *****************************
function GetAttString(doc : AcadDocument; const BlkName : string; const TagName : string): string;
var
mspc : AcadModelSpace;
ent : AcadEntity;
blkref : AcadBlockReference;
attr : OleVariant;
att : AcadAttributeReference;
idisp : IDispatch;
j , n, m, k : integer;
begin
Result := '';
mspc := doc.ModelSpace;
if mspc.Count > 0 then begin
for j := 0 to mspc.Count - 1 do begin
ent := mspc.Item(j);
if 'AcDbBlockReference' = ent.EntityName then begin
blkref := ent as AcadBlockReference;
if blkref.HasAttributes then begin
if blkname = blkref.Name then begin
attr := blkref.GetAttributes;
n := VarArrayLowBound(attr, 1);
m := VarArrayHighBound(attr, 1);
for k := n to m do begin
// 個々の属性を取得
idisp := attr[k];
att := idisp as AcadAttributeReference;
if TagName = att.TagString then begin
Result := att.TextString;
Break;
end;
end;
break;
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;
// *****************************
// タブ区切り設定ファイルを読込
// *****************************
function ReadTsv:integer;
var
sl, sltemp : TStringList;
i, cnt : integer;
tsvname : TFileName;
begin
result := 0;
cnt := 0;
tsvname := ChangeFileExt(ParamStr(0), '.tsv');
if FileExists(tsvName) then begin
sl := TStringList.Create;
try
sltemp := TStringList.Create;
try
// スペースは区切りとしない
sltemp.StrictDelimiter := True;
// 区切り文字を TAB に
sltemp.Delimiter := #09; // TAB
sl.LoadFromFile(tsvname);
SetLength(BcadAttAry, sl.Count + 2);
for i := 0 to sl.Count - 1 do begin
sltemp.DelimitedText := sl[i];
if sltemp.Count >= 4 then begin
with BcadAttAry[cnt + 2] do begin
TxtStr := sltemp[0];
BlkName := sltemp[1];
TagName := sltemp[2];
colwidth := StrToIntDef(sltemp[3], 0);
if sltemp.Count >= 5 then
ImeFlag := UpperCase(sltemp[4]) = 'ON'
else
ImeFlag := False;
chkFlag := false;
end;
Inc(cnt);
end;
end;
SetLength(BcadAttAry, cnt + 2);
// 取得数
result := cnt;
finally
sltemp.Free;
end;
finally
sl.Free;
end;
end;
end;
// *****************************
// 内部データをStringGridに
// *****************************
procedure BcadAttAryToSettingSg(sg : TStringGrid);
var
i, cnt : integer;
begin
cnt := Length(BcadAttAry);
with sg do begin
RowCount := cnt -1;
ColCount := 6;
for i := 2 to cnt -1 do begin
with BCadAttAry[i] do begin
Cells[0, i-1] := IntToStr(i-1);
Cells[1, i-1] := TxtStr;
Cells[2, i-1] := BlkName;
Cells[3, i-1] := TagName;
Cells[4, i-1] := colwidth.ToString;
if ImeFlag then Cells[5, i-1]:= 'ON'
else Cells[5, i-1]:= '';
end;
end;
end;
end;
// *****************************
// 内部データをStringGridに
// *****************************
procedure BcadAttAryToDispSg(sg : TStringGrid; stIndex: integer);
var
i, cnt : integer;
begin
cnt := Length(BcadAttAry);
with sg do begin
ColCount := cnt + 3;
// 最後は非表示
ColWidths[cnt-1] := 0;
for i := 2 to cnt -1 do begin
with BCadAttAry[i] do begin
Cells[stIndex + i-2, 0] := TxtStr;
ColWidths[stIndex + i -2] := colwidth;
end;
end;
end;
end;
// *****************************
// 印刷：BricsCAD より取得
// *****************************
procedure TForm5.Button1Click(Sender: TObject);
var
app : IAcadApplication;
docs : IAcadDocuments;
doc : IAcadDocument;
layout : IAcadLayout;
i , idx : integer;
limmax, limmin : OleVariant;
//cfg : IAcadPlotConfiguration;
tablenames : OleVariant;
n : integer;
sdir : string;
cnt : integer;
mspc : AcadModelSpace;
ent : AcadEntity;
blkref : AcadBlockReference;
att : AcadAttributeReference;
j, k : integer;
attr : OleVariant;
l, m, a: integer;
idisp : IDispatch;
s :string;
arycnt : integer;
dwgname , dwgprefix :string;
chkcnt : integer;
begin
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('サポートされていません.');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
Exit;
end;
try
docs := app.Documents;
doc := app.ActiveDocument;
sdir := doc.GetVariable('DWGPREFIX');
Edit1.Text := sdir;
Edit2.Text := sdir;
cnt := 0;
arycnt := Length(BcadAttAry);
if docs.Count > 0 then begin
with Progressbar1 do begin
Max := docs.Count;
Position := 0;
end;
with StringGrid1 do begin
RowCount := docs.Count + 1;
for i := 1 to RowCount -1 do
for j := 0 to ColCount -1 do
Cells[j, i] := '';
end;
with StringGrid2 do begin
RowCount := docs.Count + 1;
for i := 1 to RowCount -1 do
for j := 0 to ColCount -1 do
Cells[j, i] := '';
end;
for i := 0 to docs.Count - 1 do begin
doc := docs.Item(i);
dwgname := doc.GetVariable('DWGNAME');
dwgprefix := doc.GetVariable('DWGPREFIX');
if sdir = dwgprefix then begin
with StringGrid1 do begin
Cells[0, cnt + 1] := IntToStr(i + 1);
Cells[1, cnt + 1] := dwgname;
limmax := doc.GetVariable('LIMMAX');
limmin := doc.GetVariable('LIMMIN');
Cells[2, cnt + 1] := Format('%.1f',[Double(limmax[0] - limmin[0])]);
Cells[3, cnt + 1] := Format('%.1f',[Double(limmax[1] - limmin[1])]);
// ScaleA3
Cells[4, cnt + 1] := Format('%.3f',[Double(limmax[0]) / 420]);
// ScaleA4
Cells[5, cnt + 1] := Format('%.3f',[Double(limmax[0]) / 297]);
Objects[1, cnt + 1] := TObject(True);
end;
with StringGrid2 do begin
Cells[0, cnt + 1] := IntToStr(i + 1);
Cells[1, cnt + 1] := dwgname;
Cells[ColCount - 1, cnt + 1] := dwgprefix;
end;
mspc := doc.ModelSpace;
if mspc.Count > 0 then begin
// 検索済フラグを初期化
for k := 0 to arycnt-1 do
BcadAttAry[k].chkFlag := False;
for j := 0 to mspc.Count - 1 do begin
ent := mspc.Item(j);
if 'AcDbBlockReference' = ent.EntityName then begin
blkref := ent as IAcadBlockReference;
if blkref.HasAttributes then begin
for k := 0 to arycnt - 1 do begin
if not BcadAttAry[k].chkFlag then begin
if BcadAttAry[k].BlkName = blkref.Name then begin
attr := blkref.GetAttributes;
n := VarArrayLowBound(attr, 1);
m := VarArrayHighBound(attr, 1);
for l := n to m do begin
// 個々の属性を取得
idisp := attr[l];
att := idisp as IAcadAttributeReference;
s := att.TagString;
// 登録の属性のすべてを確認する
for a := 0 to arycnt -1 do begin
if not BcadAttAry[a].chkFlag then begin
if (BcadAttAry[a].BlkName = blkref.Name) and (s = BcadAttAry[a].TagName) then begin
if a < 2 then
StringGrid1.Cells[a + 7, cnt + 1] := att.TextString
else
StringGrid2.Cells[a , cnt + 1] := att.TextString;
BcadAttAry[a].chkFlag := True;
end;
end;
end;
end;
// 最終まで検索済
BcadAttAry[k].chkFlag := True;
end;
end;
end;
end;
end;
// 検索終了の確認
chkcnt := 0;
for k := 0 to arycnt -1 do
if BcadAttAry[k].chkFlag then Inc(chkcnt);
if chkcnt = arycnt then break;
end;
end;
with Progressbar1 do Position := Position + 1;
Inc(cnt);
end;
end;
with StringGrid1 do begin
RowCount := cnt + 1;
Row := 1;
Col := 2;
SetFocus;
end;
with StringGrid2 do begin
RowCount := cnt + 1;
Row := 1;
Col := 2;
//SetFocus;
end;
label6.Caption := '/' + cnt.ToString;
Progressbar1.Position := 0;
end;
layout := doc.ActiveLayout;
layout.RefreshPlotDeviceInfo;
// プリンター名一覧をBricsCADから取得
{
devnames := layout.GetPlotDeviceNames;
n := VarArrayHighBound(devnames, 1);
if n >= 0 then begin
idx := -1;
with ComboBox1 do begin
Items.Clear;
for i := 0 to n do begin
Items.Add(devnames[i]);
if (LastPrinter <> '') and (LastPrinter = devnames[i]) then
idx := i;
end;
if idx >= 0 then
ItemIndex := idx
else
ItemIndex := Items.Count -1;
// プリンター名をセット
layout.ConfigName := Items[ItemIndex];
end;
end;
}
// プリンター名一覧を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;
// ここでセットしたプリンターの用紙サイズ一覧をBricsCADから取得
layout.RefreshPlotDeviceInfo;
// 用紙サイズ一覧をBricsCADから取得
{
papernames := layout.GetCanonicalMediaNames;
n := VarArrayHighBound(papernames, 1);
if n >= 0 then begin
with ComboBox3 do begin
Items.Clear;
for i := 0 to n do
Items.Add(papernames[i]);
Sorted := True;
idx := Items.IndexOf('A4');
if idx >= 0 then
ItemIndex := idx
else
ItemIndex := Items.Count -1;
end;
end;
}
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;
tablenames := layout.GetPlotStyleTableNames;
// CTB,STB 一覧
n := VarArrayLowBound(tablenames, 1);
m := VarArrayHighBound(tablenames, 1);
if m > 0 then begin
idx := -1;
with ComboBox2 do begin
Items.Clear;
for i := n to m do begin // 2017/08/19 修正
Items.Add(tablenames[i]);
if (LastCtbStb <> '') and (LastCtbStb = tablenames[i]) then
idx := i;
end;
if idx >= 0 then
ItemIndex := idx
else
ItemIndex := Items.Count - 1;
end;
end;
DispCheckedCount;
// シート番号順
SpeedButton7Click(self);
SpeedButton11Click(self);
except
;
end;
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
app: IAcadApplication;
docs: IAcadDocuments;
doc: IAcadDocument;
i : integer;
scale : string;
papersize, plotcmd : string;
idx : integer;
devname : string;
fname : TFileName;
//cfg : IAcadPlotConfiguration;
docOrg : IAcadDocument;
layout : IAcadLayout;
begin
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('not Supports');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
exit;
end;
fname := ExtractFilePath(ParamStr(0)) + Edit7.Text;
if (Edit7.Text <> '') and FileExists(fname) then
fname := StringReplace(fname, '\', '\\', [rfReplaceAll])
else
fname := '';
try
if MessageDlg('選択ファイルを印刷しますか？', mtInformation,mbYesNo,0) = mrYes then begin
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
devname := LastPrinter;
RunFlag := True;
Button2.Enabled := False;
Button4.Enabled := True;
// 現在の図面
docOrg := app.ActiveDocument;
docs := app.Documents;
if (docs.Count > 0) then begin
with StringGrid1 do begin
ProgressBar1.Max := RowCount - 1;
ProgressBar1.Position := 0;
for i := 1 to RowCount - 1 do begin
with Progressbar1 do Position := Position + 1;
Application.ProcessMessages;
if RunFlag and Bool(Objects[1, i]) then begin
idx := StrToInt(Cells[0, i])-1;
doc := docs.Item(idx);
app.ActiveDocument := doc;
layout := doc.ActiveLayout;
layout.RefreshPlotDeviceInfo;
with ComboBox1 do
// プリンター名をセット
layout.ConfigName := Items[ItemIndex];
with ComboBox3 do
// 用紙サイズ名
layout.CanonicalMediaName := Items[ItemIndex];
with ComboBox2 do
// 印刷スタイル名
layout.StyleSheet := Items[ItemIndex];
//layout.PlotType := acExtents;
layout.PlotType := acLimits;
layout.CenterPlot := True;
layout.UseStandardScale := False;
// A3 -> A4 縮小
if Pos('A4', papersize) > 0 then begin
scale := '1:' + Format('%.3f',[StrToFloat(Cells[5, i])]);
// 尺度設定
layout.SetCustomScale(1.0, StrToFloat(Cells[5, i]));
end
// A3 -> A3
else begin
// papersize := 'A3';
scale := '1:'+Format('%.3f',[StrToFloat(Cells[4, i])]);
// 尺度設定(分子,分母）
layout.SetCustomScale(1.0, StrToFloat(Cells[4, i]));
end;
layout.RefreshPlotDeviceInfo;
// 尺度変更のため再作図が必要
doc.Regen(acAllViewports);
// 端子シンボルを最前面にするLISPを発行
if fname <> '' then
doc.SendCommand('(load "' + fname + '")' + #13);
if Edit8.Text <> '' then
doc.SendCommand(Edit8.Text + #13);
if CheckBox1.Checked then
// 印刷実行
doc.Plot.PlotToDevice(layout.ConfigName)
else begin
{
// RunCommandでは、'\' 文字が使えないため、コメントアウト
plotcmd := 'PLOT;Y;model'+#13 + devname +#13 + papersize +
';M;L;N;L;' + scale + ';C;Y;'+
LastCtbStb + ';Y;N;N;N;Y';
//app.RunCommand(plotcmd);
}
// コマンドライン版（実績有り）
plotcmd := 'PLOT' + #13 + 'Y' + #13 + 'model' + #13 + devname + #13 +
papersize + #13 + 'M' + #13 + 'L' + #13 + 'N' + #13 + 'L' + #13 +
scale + #13 + 'C' + #13 + 'Y' + #13 + LastCtbStb + #13 + 'Y' + #13 +
'N' + #13 + 'N' + #13 + 'N' + #13 + 'Y' + #13;
doc.SendCommand(plotcmd);
end;
end;
end;
end;
ProgressBar1.Position := 0;
if RunFlag then
ShowMessage('印刷が終了しました．')
else
ShowMessage('印刷を中止しました．');
Button2.Enabled := True;
Button4.Enabled := False;
// 最初の図面に戻す
docOrg.Activate;
end;
end;
end;
except
;
end;
{
: PLOT
詳細な印刷構成? はい(Y)/<いいえ(N)>: y
レイアウト名を入力 または [?] <Model>: model
出力デバイス名を入力 または [?] <pdfFactory>:
用紙サイズを入力 または [?] <A4>:
用紙単位 インチ(I)/<ミリ(M)>:
図面の向き 縦(P)/<横(L)>: l
上下を反転して印刷? はい(Y)/<いいえ(N)>: n
印刷範囲を指定 表示(D)/図形範囲(E)/<図面範囲(L)>/ビュー(V)/窓(W): l
印刷尺度を入力 (印刷 ミリ = 作図単位) または フィット(F) <1:7.07>:
印刷オフセットを入力 (x,y) または 中心(C) <Center>: c
印刷スタイルを使用? <はい(Y)>/いいえ(N): y
印刷スタイルテーブル名 または [?] (無しのときは . を入力) <monochrome018.ctb>:
線の太さを印刷? <はい(Y)>/いいえ(N): y
隠れ線を除外? はい(Y)/<いいえ(N)>: n
印刷データをファイルへ出力? はい(Y)/<いいえ(N)>: n
レイアウトへ変更を保存しますか? はい(Y)/<いいえ(N)>: n
印刷を続行? <はい(Y)>/いいえ(N): y
}
end;
// *****************************
// 中止ボタン
// *****************************
procedure TForm5.Button4Click(Sender: TObject);
begin
RunFlag := False;
Application.ProcessMessages;
end;
// *****************************
// 図面情報を更新
// *****************************
procedure TForm5.Button7Click(Sender: TObject);
var
app : AcadApplication;
docs : AcadDocuments;
doc : AcadDocument;
mspc : AcadModelSpace;
ent : AcadEntity;
blkref : AcadBlockReference;
att : AcadAttributeReference;
attr : OleVariant;
idisp : IDispatch;
i, j, k, kk, a ,l: integer;
n, m : integer;
s : string;
dwgname, dwgprefix : string;
arycnt : integer;
chkcnt : integer;
begin
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('サポートされていない');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
exit;
end;
try
arycnt := Length(BcadAttAry);
docs := app.Documents;
if docs.Count > 0 then begin
RunFlag := True;
Button7.Enabled := False;
Button3.Enabled := True;
ProgressBar1.Max := docs.Count;
with StringGrid2 do begin
for i := 0 to docs.Count - 1 do begin
with ProgressBar1 do Position := Position + 1;
Application.ProcessMessages;
if not RunFlag then break
else begin
doc := docs.Item(i);
dwgname := doc.GetVariable('DWGNAME');
dwgprefix := doc.GetVariable('DWGPREFIX');
for kk := 1 to RowCount -1 do begin
if (dwgname = Cells[1, kk]) and (dwgprefix = Cells[ColCount - 1, kk]) then begin
mspc := doc.ModelSpace;
if mspc.Count > 0 then begin
// 検索済フラグを初期化
for k := 0 to arycnt-1 do
BcadAttAry[k].chkFlag := False;
for j := 0 to mspc.Count - 1 do begin
ent := mspc.Item(j);
if 'AcDbBlockReference' = ent.EntityName then begin
blkref := ent as IAcadBlockReference;
if blkref.HasAttributes then begin
for k := 2 to arycnt-1 do begin
if not BcadAttAry[k].chkFlag then begin
if BcadAttAry[k].BlkName = blkref.Name then begin
attr := blkref.GetAttributes;
n := VarArrayLowBound(attr, 1);
m := VarArrayHighBound(attr, 1);
for l := n to m do begin
// 個々の属性を取得
idisp := attr[l];
att := idisp as IAcadAttributeReference;
s := att.TagString;
for a := 2 to arycnt - 1 do begin
if not BcadAttAry[a].chkFlag then begin
if (BcadAttAry[a].BlkName = blkref.Name) and (s = BcadAttAry[a].TagName) then begin
if Cells[a , kk] <> att.TextString then begin
att.TextString := Cells[a, kk];
att.Update;
end;
BcadAttAry[a].chkFlag := True;
end;
end;
end;
end;
end;
end;
// 最終まで検索済
BcadAttAry[k].chkFlag := True;
end;
end;
end;
// 検索終了の確認
chkcnt := 0;
for k := 0 to arycnt -1 do
if BcadAttAry[k].chkFlag then Inc(chkcnt);
if chkcnt = arycnt then Break;
end;
end;
Break;
end;
end;
end;
end;
end;
ProgressBar1.Position := 0;
end;
if RunFlag then
ShowMessage('更新が終了しました．')
else
ShowMessage('更新を中止しました．');
Button7.Enabled := True;
Button3.Enabled := False;
except
;
end;
end;
// *****************************
// プリンター変更
// *****************************
procedure TForm5.ComboBox1Change(Sender: TObject);
var
app : AcadApplication;
docs : AcadDocuments;
doc : AcadDocument;
cfg : AcadPlotConfiguration;
i : integer;
begin
with ComboBox1 do begin
if ItemIndex >= 0 then
LastPrinter := Items[ItemIndex];
end;
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('サポートされていません.');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
exit;
end;
try
docs := app.Documents;
doc := app.ActiveDocument;
if doc.PlotConfigurations.Count = 0 then
doc.PlotConfigurations.Add('TEST', 0);
cfg := doc.PlotConfigurations.Item(0);
if Assigned(cfg) then begin
with ComboBox1 do
// プリンター名をセット
cfg.ConfigName := Items[ItemIndex];
// ここでセットしたプリンターの用紙サイズ一覧
{
papernames := cfg.GetCanonicalMediaNames;
n := VarArrayHighBound(papernames, 1);
if n > 0 then begin
with ComboBox3 do begin
Items.Clear;
for i := 0 to n - 1 do
Items.Add(papernames[i]);
Sorted := True;
idx := Items.IndexOf('A4');
if idx >= 0 then
ItemIndex := idx
else
ItemIndex := Items.Count -1;
end;
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;
except
;
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;
i : integer;
begin
PageControl1.ActivePageIndex := 0;
Edit1.Text := '';
Edit2.Text := '';
Edit3.Text := 'TITLE';
Edit4.Text := 'ZSHEET';
Edit5.Text := 'TITLE';
Edit6.Text := 'ZITEM9';
Edit7.Text := 'TBTOTOP.lsp';
Edit8.Text := 'TBTOTOP';
Caption := Application.Title;
with StringGrid1 do begin
RowCount := 2;
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;
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';
end;
with StringGrid2 do begin
RowCount := 2;
// 初期値
ColWidths[0] := 30;
ColWidths[1] := 160;
ColWidths[6] := 80;
ColWidths[7] := 50;
for i := 8 to 10 do ColWidths[i] := 40;
for i := 11 to 16 do ColWidths[i] := 50;
Cells[0, 0] := 'No.';
Cells[1, 0] := 'ファイル名';
end;
with StringGrid4 do begin
Options := Options + [goThumbTracking,goEditing];
DefaultColWidth := 60;
ColWidths[0] := 30;
ColWidths[1] := 80;
Cells[0, 0] := 'No.';
Cells[1, 0] := '表示名称';
Cells[2, 0] := 'ブロック名';
Cells[3, 0] := '属性名';
Cells[4, 0] := '表示幅';
Cells[5, 0] := 'IME';
end;
// 図形情報の設定ファイルを読込
ReadTsv;
// 検索用に追加
BcadAttAry[0].BlkName := Edit3.Text;
BcadAttAry[0].TagName := Edit4.Text;
BcadAttAry[0].chkFlag := False;
BcadAttAry[1].BlkName := Edit5.Text;
BcadAttAry[1].TagName := Edit6.Text;
BcadAttAry[1].chkFlag := False;
BcadAttAryToSettingSg(StringGrid4);
BcadAttAryToDispSg(StringGrid2, 2);
with StringGrid2 do
ColWidths[ColCount -1] := 0;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
with ini do begin
try
LastPrinter := ReadString('Plot', 'LastPrinter', '');
LastCtbStb := ReadString('Plot', 'LastCtbStb', '');
Edit3.Text := ReadString('BlkAtt', 'BlkName1', Edit3.Text);
Edit4.Text := ReadString('BlkAtt', 'AttName1', Edit4.Text);
Edit5.Text := ReadString('BlkAtt', 'BlkName2', Edit5.Text);
Edit6.Text := ReadString('BlkAtt', 'AttName2', Edit6.Text);
Edit7.Text := ReadString('RunLisp', 'FileName', Edit7.Text);
Edit8.Text := ReadString('RunLisp', 'Command', Edit8.Text);
with StringGrid1 do
ColWidths[1] := ReadInteger('Form', 'FNameWidth', ColWidths[1] );
finally
Free;
end;
end;
end;
// *****************************
// フォーム破棄
// *****************************
procedure TForm5.FormDestroy(Sender: TObject);
var
ini : TIniFile;
begin
// 設定ファイルを保存
SpeedButton6Click(self);
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), 'ini'));
with ini do begin
try
WriteString('Plot','LastPrinter', LastPrinter);
WriteString('Plot','LastCtbStb', LastCtbStb);
WriteString('BlkAtt', 'BlkName1', Edit3.Text);
WriteString('BlkAtt', 'AttName1', Edit4.Text);
WriteString('BlkAtt', 'BlkName2', Edit5.Text);
WriteString('BlkAtt', 'AttName2', Edit6.Text);
WriteString('RunLisp', 'FileName', Edit7.Text);
WriteString('RunLisp', 'Command', Edit8.Text);
WriteInteger('Form', 'FNameWidth', StringGrid1.ColWidths[1] );
finally
Free;
end;
end;
end;
// *****************************
// ファイル名の表示幅を合わせる
// *****************************
procedure TForm5.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex = 1 then
StringGrid2.ColWidths[1] := StringGrid1.ColWidths[1];
end;
// *****************************
// 図面情報：ファイル名順
// *****************************
procedure TForm5.SpeedButton10Click(Sender: TObject);
begin
SgSortByCol2(StringGrid2, StringGrid2.ColCount -1, 1, False);
end;
// *****************************
// 図面情報：シート名順ソート
// *****************************
procedure TForm5.SpeedButton11Click(Sender: TObject);
var
i : integer;
n : integer;
begin
n := Length(BcadAttAry);
if n > 0 then begin
for i := 2 to n - 1 do begin
with BcadAttAry[i] do begin
if (BlkName = Edit3.Text) and (TagName = Edit4.Text) then begin
SgSortByCol2(StringGrid2, i, - 1, False);
Break;
end;
end;
end;
end;
end;
// *****************************
// 図面情報：取得順ソート
// *****************************
procedure TForm5.SpeedButton12Click(Sender: TObject);
begin
SgSortByCol2(StringGrid2, 0, - 1, True);
end;
procedure TForm5.SpeedButton13Click(Sender: TObject);
var
i : integer;
begin
with StringGrid4 do begin
for i := 1 to RowCount - 1 do begin
Cells[4, i] := IntToStr(StringGrid2.ColWidths[i + 1]);
end;
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.SpeedButton4Click(Sender: TObject);
begin
// ソート
SgSortByCol2(StringGrid1, 6, 1, False);
end;
// *****************************
// 印刷「ページＮｏ順」
// *****************************
procedure TForm5.SpeedButton5Click(Sender: TObject);
var
i : integer;
n : integer;
begin
n := Length(BcadAttAry);
if n > 2 then begin
for i := 2 to n - 1 do begin
with BcadAttAry[i] do begin
if (BlkName = Edit5.Text) and (TagName = Edit6.Text) then begin
// ページＮｏ順ソート
SgSortByCol2(StringGrid2, i, - 1, True);
Break;
end;
end;
end;
end;
end;
// *****************************
// 設定ファイルを保存
// *****************************
procedure TForm5.SpeedButton6Click(Sender: TObject);
var
sl : TStringList;
i, j : integer;
tsvname : TFileName;
s : string;
begin
tsvname := ChangeFileExt(ParamStr(0), '.tsv');
sl := TStringList.Create;
try
with StringGrid4 do begin
for i := 1 to RowCount - 1 do begin
with BcadAttAry[i + 1] do begin
TxtStr := Cells[1, i];
BlkName := Cells[2, i];
TagName := Cells[3, i];
colwidth := StrToIntDef(Cells[4, i], 0);
ImeFlag := UpperCase(Cells[5, i]) = 'ON';
end;
s := '';
for j := 1 to 5 do begin
s := s + Cells[j, i];
// タブを追加
if j < 5 then s := s + #9;
end;
sl.Add(s);
end;
end;
sl.SaveToFile(tsvname);
finally
sl.Free;
end;
end;
// *****************************
// 印刷：シート名順ソート
// *****************************
procedure TForm5.SpeedButton7Click(Sender: TObject);
begin
SgSortByCol2(StringGrid1, 7, - 1, False);
end;
// *****************************
// 図面情報：ページ番号順ソート
// *****************************
procedure TForm5.SpeedButton8Click(Sender: TObject);
begin
SgSortByCol2(StringGrid1, 8, - 1, True);
end;
// *****************************
// 印刷：取得順ソート
// *****************************
procedure TForm5.SpeedButton9Click(Sender: TObject);
begin
SgSortByCol2(StringGrid1, 0, - 1, True);
end;
// *****************************
// 印刷用StringGridクリック
// *****************************
procedure TForm5.StringGrid1Click(Sender: TObject);
var
app : AcadApplication;
docs : AcadDocuments;
doc : AcadDocument;
idx : integer;
limmax, limmin : OleVariant;
begin
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('サポートされていない');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
exit;
end;
try
with StringGrid1 do begin
if Row > 0 then begin
idx := StrToIntDef(Cells[0, Row], - 1) - 1;
docs := app.Documents;
if (idx >= 0) and (idx < docs.Count) then begin
// 図面を切換え
app.ActiveDocument := docs.Item(idx);
doc := app.ActiveDocument;
limmax := doc.GetVariable('LIMMAX');
limmin := doc.GetVariable('LIMMIN');
//SetForegroundWindow(App.HWND);
// ズームする
app.ZoomWindow(limmin, limmax);
end;
end;
end;
except
;
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;
// *****************************
// 図面情報StringGrid クリック
// *****************************
procedure TForm5.StringGrid2Click(Sender: TObject);
var
app : AcadApplication;
docs : AcadDocuments;
doc : AcadDocument;
idx : integer;
limmax, limmin : OleVariant;
i , n: integer;
begin
n := Length(BcadAttAry);
with StringGrid2 do begin
if (Col < 2) or (Col >= n) then
ImmSetOpenStatus(ImmGetContext(Handle), False)
else
for i := 2 to n - 1 do begin
if Col = i then begin
ImmSetOpenStatus(ImmGetContext(Handle), BcadAttAry[i].ImeFlag);
Break;
end;
end;
// ファイル名は変更不可
if Col = 1 then
Options := Options - [goEditing]
else
Options := Options + [goEditing];
end;
try
if not Supports(GetActiveOleObject('BricscadApp.AcadApplication'), AcadApplication, app) then begin
ShowMessage('サポートされていない');
exit;
end;
except
ShowMessage('有効な BricsCAD が見つかりません．');
exit;
end;
try
with StringGrid2 do begin
if Row > 0 then begin
idx := StrToIntDef(Cells[0, Row], - 1) - 1;
docs := app.Documents;
if (idx >= 0) and (idx < docs.Count) then begin
app.ActiveDocument := docs.Item(idx);
doc := app.ActiveDocument;
limmax := doc.GetVariable('LIMMAX');
limmin := doc.GetVariable('LIMMIN');
//SetForegroundWindow(App.HWND);
app.ZoomWindow(limmin, limmax);
end;
end;
end;
except
;
end;
end;
// *****************************
// 図面情報StringGrid キー操作
// *****************************
procedure TForm5.StringGrid2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
SgKeyDown(StringGrid2, Key, Shift);
end;
end.
