 |
| const
acAlignmentMiddleLeft = 9;
var
app: OleVariant;
doc: OLeVariant;
vpt1, vpt2, vpt3 : OleVariant;
txt : OleVariant;
line : OleVariant;
grp : OleVariant;
ents : OleVariant;
mspc: OleVariant;
head, s, grpName : string;
cnt, i, j, entCnt: integer;
sl: TStringList;
grpFlag: boolean;
begin
if isBcadActive then begin
App := GetActiveOleObject(gbProgID);
SetForegroundWindow(app.HWND);
Doc := App.ActiveDocument;
Mspc := Doc.ModelSpace;
vpt1 := VarArrayCreate([0, 2], varDouble);
vpt2 := VarArrayCreate([0, 2], varDouble);
vpt3 := VarArrayCreate([0, 2], varDouble);
ents := varArrayCreate([0, 0], varDispatch);
entCnt := 0;
// LINE を作成
vpt1[0] := 10; vpt1[1] := 6; vpt1[2] := 0;
vpt2[0] := 80; vpt2[1] := 6; vpt2[2] := 0;
line := mspc.AddLine(vpt1, vpt2);
Inc(entCnt);
VarArrayReDim(ents, entCnt-1);// 添字の上限を変更
ents[entCnt-1] := line;
// TEXT を作成
vpt3[0] := 10; vpt3[1] := 10; vpt3[2] := 0;
txt := mspc.AddText('GROUP_TEST', vpt3, 2.5);
txt.Alignment := acAlignmentMiddleLeft;
txt.TextAlignmentPoint := vpt3;
Inc(entCnt);
VarArrayReDim(ents, entCnt-1);// 添字の上限を変更
ents[entCnt-1] := txt;
// 重複しないグループ名を作成
head := 'TEMP'; // グループ名 TEMP00 〜 TEMP99 を想定
cnt := Doc.Groups.Count;
grpFlag := False;
if cnt = 0 then begin
grpFlag := True;
grpName := head + '00';
end
else begin
sl := TStringList.Create();
try
for i := 0 to cnt-1 do
sl.Add(UpperCase(Doc.Groups.Item[i].Name)+#9);
sl.Sorted := True;
Memo1.Lines.Assign(sl);
for i := 0 to sl.Count-1 do begin
for j := 0 to 99 do begin
s := head + Format('%.2d', [j]) + #9;
if sl.IndexOf(s)<0 then begin
grpName := Trim(s);
grpFlag := True;
break;
end;
end;
if grpFlag then break;
end;
finally
sl.Free;
end;
end;
// グループを作成
if grpFlag then begin
grp := Doc.Groups.Add(grpName);
// すでに同じグループ名が存在するときは図形が追加される
grp.AppendItems(VarArrayRef(ents));
end;
end;
※半角スペース2個を全角スペースに置換しています。 |