ちょっと早いクリスマスプレゼントです。
標準の2Dパステキストは曲線上に文字を配置出来ないので，スクリプトを書いてみました。
アクティブレイヤの文字とパス図形を選択して実行します。

パス図形は、多角形に変換できる図形なら何でも構いません。（渦巻き図形もグループ解除す
れば可能です。）

VW11ではDoMenuTextByNameが正常に動作しないので、113〜116行をコメントアウトして、117
行を有効にしてください。

procedure AlignTextOnCurve;
{ パス図形に沿って、文字を均等配列にする（VW8.5〜10.5） }
{ VW11では、113〜116行をコメントアウトして、117行を有効にする }
{ アクティブレイヤの文字とパス図形を選択して実行 }
{$ DEBUG}
const
＿MaxIndex = 254;
＿LineObj = 2;
＿RectObj = 3;
＿OvalObj = 4;
＿PolyObj = 5;
＿ArcObj = 6;
＿RRectObj = 13;
＿CurveObj = 21;
＿TextObj = 10;
＿LF = Chr(13);
＿
var
＿hT, hP, hG＿:handle;
＿str＿:string;
＿ch_num＿:integer;
＿txt_color＿:integer;
＿txt_vAlign＿:integer;
＿ch_numByte, ch_font, ch_size, ch_style＿:array[0..MaxIndex] of integer;
＿ch_dist, ch_wd, ch_x, ch_y, ch_ang＿:array[0..MaxIndex] of real;
＿ch_chars＿:array[0..MaxIndex, 1..2] of char;
＿ch_isSpace＿:array[0..MaxIndex] of boolean;
＿ch_hnd＿:array[0..MaxIndex] of handle;
＿pathLen＿:real;
＿spc＿:real;
＿
function Closed(hPoly: handle): boolean;
{多角形が閉じていればTRUEを返します。}
var
＿fPat:integer;
begin
＿fPat:= GetFPat(hPoly);
＿SetFPat(hPoly, 0);
＿if HArea(hPoly) = 0 then
＿＿Closed:= false
＿else
＿＿Closed:= true;
＿SetFPat(hPoly, fPat);
end; {Closed}

function GetNumByte(c:char):integer;
{ 文字のバイト数を返します。 }
var
＿result＿:integer;
begin
＿case Ord(c) of
＿＿129..159, 224..252: result:= 2;
＿＿otherwise result:= 1;
＿end;{case}＿
＿GetNumByte:= result;
end;{GetNumByte}

function GetColorIndex(h:handle):integer;
{ カラー番号を返します。 }
var
＿result＿:integer;
＿r, g, b＿:real;
begin
＿GetPenFore(h, r, g, b);
＿RGBToColorIndex(r, g, b, result);
＿GetColorIndex:= result;
end;{GetColorIndex}

procedure GetHandles(var hText, hPath:handle);
{ 図形ハンドルを取得 }
var
＿h＿:handle;
＿x1, y1, x2, y2＿:real;
begin
＿h:= FSActLayer;
＿while (h <> nil) do begin
＿＿if h <> nil then begin
＿＿＿case GetType(h) of
＿＿＿＿LineObj..ArcObj, RRectObj, CurveObj:
＿＿＿＿＿hPath:= h;
＿＿＿＿TextObj:
＿＿＿＿＿hText:= h;
＿＿＿end;{case}
＿＿＿h:= NextSObj(h);
＿＿end;{if}
＿end;{while}
end;{GetHandles}

procedure Convert_Curve2Poly(var h:handle);
{ パス図形を多角形に変換 }
var
＿x1, y1, x2, y2＿:real;
＿x, y＿:real;
＿h0＿:handle;
＿i＿:integer;
＿arcDiv＿:integer;
begin
＿DSelectAll;
＿if GetType(h) = LineObj then begin
＿＿GetSegPt1(h, x1, y1);
＿＿GetSegPt2(h, x2, y2);
＿＿OpenPoly;
＿＿Poly(x1, y1, (x1+x2)/2, (y1+y2)/2, x2, y2);
＿＿h:= LNewObj;
＿end{if}
＿else begin
＿＿arcDiv:= GetPrefInt(55);
＿＿if GetType(h) = ArcObj then
＿＿＿SetPrefInt(55, 512)
＿＿else
＿＿＿SetPrefInt(55, 128);
＿＿SetSelect(h);＿{VW8.5〜10.5}
＿＿Duplicate(0, 0);＿{VW8.5〜10.5}
＿＿h:= LSActLayer;＿{VW8.5〜10.5}
＿＿DoMenuTextByName('Convert to Polygons', 0);＿{VW8.5〜10.5}
{＿＿h:= MakePolygon(h);＿}{ VW11 }
＿＿SetPrefInt(55, arcDiv);
＿end;{else}
＿if Closed(h) then begin
＿＿h0:= h;
＿＿BeginPoly;
＿＿for i:= 1 to GetVertNum(h) do begin
＿＿＿GetPolyPt(h, i, x, y);
＿＿＿AddPoint(x, y);
＿＿end;{for}
＿＿GetPolyPt(h, 1, x, y);
＿＿AddPoint(x, y);
＿＿EndPoly;
＿＿h:= LNewObj;
＿＿DelObject(h0)
＿end;
end;{Convert_Curve2Poly}

procedure GetTextInformation;
{ 文字情報を取得 }
var
＿i, j, n＿:integer;
＿c＿:char;
begin
＿txt_color:= GetColorIndex(hT);
＿txt_vAlign:= GetTextVerticalAlign(hT);
＿n:= GetTextLength(hT);
＿i:= 0;
＿j:= 0;
＿str:= GetText(hT);
＿while (i < n) & (j <= MaxIndex) do begin
＿＿c:= copy(str, i+1, 1);
＿＿ch_chars[j, 1]:= c;
＿＿ch_font[j]:= GetTextFont(hT, i);
＿＿ch_size[j]:= GetTextSize(hT, i);
＿＿ch_style[j]:= GetTextStyle(hT, i);
＿＿ch_numByte[j]:= GetNumByte(c);
＿＿ch_chars[j, 1]:= copy(str, i+1, 1);
＿＿if ch_numByte[j] = 2 then
＿＿＿ch_chars[j, 2]:= copy(str, i+2, 1);
＿＿c:= ch_chars[j, 1];
＿＿if c = ' ' then begin
＿＿＿ch_chars[j, 1]:= '.';{ WinのVW10で空白の幅がゼロになる為（Macは未確認） }
＿＿＿ch_isSpace[j]:= true;
＿＿end
＿＿else begin
＿＿＿ch_isSpace[j]:= false;
＿＿end;{if}
＿＿i:= i + ch_numByte[j];
＿＿j:= j + 1;
＿end;{while}
＿ClrMessage;
＿if (MaxIndex < j) then
＿＿Message(MaxIndex+1, '文字以上は無視されます。');
＿ch_num:= j;
end;{GetTextInformation}

procedure CreateChars;
{ 文字を生成 }
var
＿x, y＿:real;
＿i＿:integer;
begin
＿TextJust(2);＿{Center}
＿TextVerticalAlign(txt_vAlign);
＿PenFore(txt_color);
＿HCenter(hP, x, y);
＿for i:= 0 to ch_num-1 do begin
＿＿TextFont(ch_font[i]);
＿＿Textsize(ch_size[i]);
＿＿TextOrigin(x, y);
＿＿if ch_numByte[i] = 2 then
＿＿＿CreateText(Concat(ch_chars[i, 1], ch_chars[i, 2]))
＿＿else {ch_numByte[i] = 1}
＿＿＿CreateText(ch_chars[i, 1]);
＿＿ch_hnd[i]:= LNewObj;
＿＿SetTextStyle(ch_hnd[i], 0, ch_numByte[i], 0);
＿＿SetTextStyle(ch_hnd[i], 0, ch_numByte[i], ch_style[i]);
＿end;{for}
end;{CreateChars}

function GetSpaceDistance(numText:integer; lng:real):real;
{ 文字間距離を取得 }
var
＿result＿:real;
＿wd＿:real;
＿numSpc＿:integer;
＿i＿:integer;
＿x1, y1, x2, y2＿:real;
begin
＿numSpc:= 0;
＿wd:= 0;
＿for i:= 0 to numText-1 do begin
＿＿GetBBox(ch_hnd[i], x1, y1, x2, y2);
＿＿ch_wd[i]:= x2 - x1;
＿＿if (0 < i) & (i < (lng-1)) then begin
＿＿＿numSpc:= numSpc + 2*ch_numByte[i];
＿＿end
＿＿else begin
＿＿＿numSpc:= numSpc + ch_numByte[i];
＿＿end;
＿＿wd:= wd + x2 - x1;
＿end;{for}
＿GetSpaceDistance:=(pathLen - wd) / numSpc;
end;{GetSpaceDistance}

procedure SetDistOnCurve(num:integer; lng0, spc:real);
{ 始点から文字基点までの距離を計算 }
var
＿i＿:integer;
begin
＿ch_dist[0]:= ch_wd[0] / 2;
＿for i:= 1 to num-1 do begin
＿＿ch_dist[i]:= ch_dist[i-1] + (ch_wd[i-1] + ch_wd[i]) / 2 + spc * (ch_numByte[i-1] + ch_numByte[i]);
＿end;{for}
end;{SetDistOnCurve}

procedure SetTextOrientationOnCurve(num:integer);
{ 多角形上の文字基点座標と角度を計算 }
var
＿i, j, n＿:integer;
＿d, dd＿:real;
＿x0, y0, x, y＿:real;
＿v＿:vector;
begin
＿dd:= 0;
＿j:= 1;
＿n:= GetVertNum(hP);
＿GetPolyPt(hP, j, x0, y0);
＿for i:= 0 to num-1 do begin
＿＿while (dd < ch_dist[i]) & (j < n) do begin
＿＿＿j:= j + 1;
＿＿＿GetPolyPt(hP, j, x, y);
＿＿＿d:= Distance(x0, y0, x, y);
＿＿＿dd:= dd + d;
＿＿＿v[1]:= x - x0;
＿＿＿v[2]:= y - y0;
＿＿＿x0:= x; y0:= y;
＿＿end;{while}
＿＿ch_ang[i]:= Vec2Ang(v);
＿＿ch_x[i]:= x - v[1] * (dd-ch_dist[i]) / d;
＿＿ch_y[i]:= y - v[2] * (dd-ch_dist[i]) / d;
＿{＿ReDraw;＿}
＿end;{for}
end;{SetTextOrientationOnCurve}

procedure ArrangeChars(num:integer);
{ 文字を配置 }
var
＿i＿:integer;
begin
＿for i:= 0 to num-1 do begin
＿＿SetTextOrientation(ch_hnd[i], ch_x[i], ch_y[i], ch_ang[i], false);
＿end;{for}
end;{ArrangeChars}

procedure ResetSpace(num:integer);
{ 「.」を空白に戻す }
var
＿i＿:integer;
begin
＿for i:= 0 to num-1 do begin
＿＿if ch_isSpace[i] then
＿＿＿SetText(ch_hnd[i], ' ');
＿end;
end;{ResetSpace}

begin{main}
＿PushAttrs;
＿GetHandles(hT, hP);
＿if (hP = nil) | (hT = nil) then begin
＿＿AlrtDialog(Concat('アクティブレイヤで、', LF,
＿＿＿'文字と曲線を選択して実行してください。'));
＿end{if}
＿else begin
＿＿GetTextInformation;
＿＿Convert_Curve2Poly(hP);
＿＿BeginGroup;
＿＿＿CreateChars;
＿＿EndGroup;
＿＿hG:= LNewObj;
＿＿pathLen:= HPerim(hP);
＿＿spc:= GetSpaceDistance(ch_num, pathLen);
＿＿SetDistOnCurve(ch_num, pathLen, spc);
＿＿SetTextOrientationOnCurve(ch_num);
＿＿ArrangeChars(ch_num);
＿＿ResetSpace(ch_num);
＿＿DelObject(hP);
＿＿ResetBBox(hG);
＿end;{if}
＿PopAttrs;
end;{main}
Run(AlignTextOnCurve);

文字を各々の文字基点で回転します。
「文字の角度を設定するスクリプト」では対応できないときに使います。
絶対角度指定と相対角度（回転角）指定の違い、という意味ではなく、
角度が異なる文字を同じだけ回転させるような場合です。

procedure RotText;
{ 文字を回転する。 }
{ アクティブレイヤの文字（グループでも可）を選択して、実行する。 }
const
＿TextObj = 10;
＿GroupObj = 11;
var
＿numText＿:integer;
＿angRot＿:real;
＿countMode＿:boolean;
＿
procedure DoText(h:handle);
var
＿x, y, a＿:real;
＿flip＿:boolean;
begin
＿if countMode then begin
＿＿numText:= numText + 1;
＿end{if}
＿else begin
＿＿GetTextOrientation(h, x, y, a, flip);
＿＿SetTextOrientation(h, x, y, angRot + a, flip);
＿end;{else}
end;{DoText}

procedure DoInGroup(hP:handle);
var
＿h＿:handle;
begin
＿h:= FInGroup(hP);
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextObj(h);
＿end;
end;{DoInGroup}

procedure DoInLayer;
var
＿h＿:handle;
begin
＿h:= FSActLayer;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextSObj(h);
＿end;
end;{DoInLayer}

begin
＿countMode:= true;
＿numText:= 0;
＿DoInLayer;
＿＿
＿if numText = 0 then begin
＿＿AlrtDialog('文字を選択してください。');
＿end{if}
＿else begin
＿＿angRot:= AngDialog('文字の回転角度(dA) = ', '0.00°');
＿＿if not DidCancel then begin
＿＿＿countMode:= false;
＿＿＿DoInLayer;
＿＿end;{if}
＿end;{else}
end;
Run(RotText);

＞文字属性（スタイル）が一文字置きにしか設定されません...
スタイルを設定する前にリセットする必要があるようです。

SetTextStyle(hT, st, lng, GetTextStyle(hC, 0));
の前に、
SetTextStyle(hT, st, lng, 0);
を入れれば良いようです。

文字属性（スタイル）が一文字置きにしか設定されません...残念！

文字の角度を設定するスクリプトを、少し直しただけです。

procedure MoveTextVertical;
{ 文字を高さ方向に移動する。 }
{ アクティブレイヤの文字（グループでも可）を選択して、実行する。 }
const
＿TextObj = 10;
＿GroupObj = 11;
var
＿numText＿:integer;
＿dH＿:real;
＿countMode＿:boolean;
＿
procedure DoText(h:handle);
var
＿x, y, a＿:real;
＿v＿:vector;
＿flip＿:boolean;
begin
＿if countMode then begin
＿＿numText:= numText + 1;
＿end{if}
＿else begin
＿＿GetTextOrientation(h, x, y, a, flip);
＿＿v:= Ang2Vec(a+90, dH);
＿＿x:= x + v[1]; y:= y + v[2];
＿＿SetTextOrientation(h, x, y, a, flip);
＿end;{else}
end;{DoText}

procedure DoInGroup(hP:handle);
var
＿h＿:handle;
begin
＿h:= FInGroup(hP);
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextObj(h);
＿end;
end;{DoInGroup}

procedure DoInLayer;
var
＿h＿:handle;
begin
＿h:= FSActLayer;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextSObj(h);
＿end;
end;{DoInLayer}

begin{main}
＿countMode:= true;
＿numText:= 0;
＿DoInLayer;
＿＿
＿if numText = 0 then begin
＿＿AlrtDialog('文字を選択してください。');
＿end{if}
＿else begin
＿＿dH:= AngDialog('文字の移動距離(dH) = ', '0.00');
＿＿if not DidCancel then begin
＿＿＿countMode:= false;
＿＿＿DoInLayer;
＿＿end;{if}
＿end;{else}
end;{main}
Run(MoveTextVertical);

＞与太郎さん
あっけないぐらい短時間で組み直せました。実際の仕事の中でテストしていきます。
どうもでした。

＞これを10.3と10.4てな具合にしていきたいのです。
おお、間違いました...。3.3と3.4です。
一度、整数化して計算して、その後に戻せばいいんですね。そうすれば余りの計算も出
来ますね。再考してみます。

やってはいけない割り算、はゼロ除算ですが、

＞10を3で割って3.3333...となりますが、
＞これを10.3と10.4てな具合にしていきたいのです。
これは意味がわかりません...　
3.3と3.4の間違いだったら、
1. Int(10.0/3 * 10)/10 → 3.3、余り=6.7
2. Int( 6.7/2 * 10)/10 → 3.3、余り=3.4
3. Int( 3.4/1 * 10)/10 → 3.4、余り=0
という考え方でどうでしょうか？

グループ図形の中の文字を全て連結して、一つの文字図形にしています。

procedure Group2Text;
{ 均等割付文字（グループ図形）から、文字を抽出する }
{$ DEBUG}
const
＿TextObj = 10;
＿GroupObj = 11;
var
＿hG, hC, hT＿:handle;
＿x, y＿:real;
＿st, ed＿:integer;
＿s, ss＿:string;
＿
function GetColorIndex(h:handle):integer;
{ カラー番号を返します。 }
var
＿result＿:integer;
＿r, g, b＿:real;
begin
＿GetPenFore(h, r, g, b);
＿RGBToColorIndex(r, g, b, result);
＿GetColorIndex:= result;
end;{GetColorIndex}

function CountText(hG:handle):integer;
{ グループ図形の中の文字図形を数える }
var
＿n＿:integer;
＿h＿:handle;
begin
＿n:= 0;
＿h:= FInGroup(hG);
＿while h <> nil do begin
＿＿if GetType(h) = TextObj then
＿＿＿n:= n + 1;
＿＿h:= NextObj(h);
＿end;{while}
＿CountText:= n;
end;{CountText}

procedure DupTextAtrrs(hT, hC:handle; st, ed:integer);
var
＿lng＿:integer;
begin
＿lng:= ed - st + 1;
＿SetTextFont(hT, st, lng, GetTextFont(hC, 0));
＿SetTextSize(hT, st, lng, GetTextSize(hC, 0));
＿SetTextStyle(hT, st, lng, GetTextStyle(hC, 0));
end;{DupTextAtrrs}

begin{main}
＿hG:= FSActLayer;
＿if (hG <> nil) & (GetType(hG) = GroupObj) & (0 < CountText(hG)) then begin
＿＿DSelectAll;
＿＿ss:= '';
＿＿st:= 0;
＿＿hT:= nil;
＿＿hC:= FInGroup(hG);
＿＿while hC <> nil do begin
＿＿＿if GetType(hC) = TextObj then begin
＿＿＿＿ed:= st + GetTextLength(hC) - 1;
＿＿＿＿s:= GetText(hC);
＿＿＿＿if hT = nil then begin
＿＿＿＿＿ss:= s;
＿＿＿＿＿GetVCenter(x, y);
＿＿＿＿＿TextOrigin(x, y);
＿＿＿＿＿CreateText(ss);
＿＿＿＿＿hT:= LNewObj;
＿＿＿＿＿SetPenFore(hT, GetColorIndex(hC));
＿＿＿＿＿SetTextJust(hT, 2);
＿＿＿＿end{if}
＿＿＿＿else begin
＿＿＿＿＿ss:= Concat(ss, GetText(hC));
＿＿＿＿＿SetText(hT, ss);
＿＿＿＿end;{else}
＿＿＿＿DupTextAtrrs(hT, hc, st, ed);
＿＿＿＿st:= ed + 1;
＿＿＿end;{if}
＿＿＿hC:= NextObj(hC);
＿＿end;{while}
＿end{if}
＿else begin
＿＿AlrtDialog('均等割付文字を選択してください。');
＿end;{else}
end;{main}
Run(Group2Text);

どうしても割付けプログラムを考えたいのですが、これで避けては通れない除算なんで
すが、一番の問題の余りの処理！10を3で割って3.3333...となりますが、これを10.3と
10.4てな具合にしていきたいのです。なんか、ヒントがないですか？

構造体をやめたので、VW8.5でも動きます。
if ch_chars[j, 1] = ' ' だとVW9で落ちるので、一旦 c に代入して、
if c = ' ' then としました。

procedure AlignText;
{ 文字を直線の長さで均等配列にする（VW8.5以降） }
{ アクティブレイヤの文字と直線を選択して実行 }
{$ DEBUG}
const
＿MaxIndex = 254;
＿LineObj = 2;
＿TextObj = 10;
＿LF = Chr(13);
＿
var
＿ch_numByte＿:array[0..MaxIndex] of integer;
＿ch_chars＿:array[0..MaxIndex, 1..2] of char;
＿ch_font,
＿ch_size,
＿ch_style＿:array[0..MaxIndex] of integer;
＿ch_wd＿:array[0..MaxIndex] of real;
＿ch_hnd＿:array[0..MaxIndex] of handle;
＿ch_isSpace＿:array[0..MaxIndex] of boolean;
＿
＿txtLen＿:integer;
＿txtVAlign＿:integer;
＿txtColor＿:integer;
＿r, g, b＿:real;
＿i, j, n＿:integer;
＿c＿:char;
＿s＿:string;
＿h, hL, hT, hG＿:handle;
＿rot, lnLen＿:real;
＿x0, y0, x, y＿:real;
＿x1, y1, x2, y2＿:real;
＿spc, wd＿:real;
＿numSpc＿:integer;
＿
function GetNumByte(c:char):integer;
var
＿result＿:integer;
begin
＿case Ord(c) of
＿＿129..159, 224..252: result:= 2;
＿＿otherwise result:= 1;
＿end;{case}＿
＿GetNumByte:= result;
end;{GetNumByte}

begin{main}
＿PushAttrs;
＿{ 図形ハンドルを取得 }
＿h:= FSActLayer;
＿while (h <> nil) do begin
＿＿if h <> nil then begin
＿＿＿if GetType(h) = LineObj then
＿＿＿＿hL:= h
＿＿＿else if GetType(h) = TextObj then
＿＿＿＿hT:= h;
＿＿＿h:= NextSObj(h);
＿＿end;{if}
＿end;{while}
＿h:= nil;
＿
＿DSelectAll;
＿
＿if (hL = nil) | (hT = nil) then begin
＿＿AlrtDialog(Concat('アクティブレイヤで、', LF,
＿＿＿'文字と直線を選択して実行してください。'));
＿end{if}
＿else begin
＿{ 文字情報を取得 }
＿＿GetPenFore(hT, r, g, b);
＿＿RGBToColorIndex(r, g, b, txtColor);
＿＿txtVAlign:= GetTextVerticalAlign(hT);
＿＿n:= GetTextLength(hT);
＿＿i:= 0;
＿＿j:= 0;
＿＿s:= GetText(hT);
＿＿while (i < n) do begin
＿＿＿c:= copy(s, i+1, 1);
＿＿＿ch_chars[j, 1]:= c;
＿＿＿ch_font[j]:= GetTextFont(hT, i);
＿＿＿ch_size[j]:= GetTextSize(hT, i);
＿＿＿ch_style[j]:= GetTextStyle(hT, i);
＿＿＿ch_numByte[j]:= GetNumByte(c);
＿＿＿if ch_numByte[j] = 2 then
＿＿＿＿ch_chars[j, 2]:= copy(s, i+2, 1);
＿＿＿c:= ch_chars[j, 1];
＿＿＿if c = ' ' then begin{ if ch_chars[j, 1] = ' ' だとVW9で落ちる }
＿＿＿＿ch_chars[j, 1]:= '.';{ WinのVW10で空白の幅がゼロになる為（Macは未確認） }
＿＿＿＿ch_isSpace[j]:= true;
＿＿＿end
＿＿＿else begin
＿＿＿＿ch_isSpace[i]:= false;
＿＿＿end;{if}
＿＿＿i:= i + ch_numByte[j];
＿＿＿j:= j + 1;
＿＿end;{while}
＿＿txtLen:= j;
＿＿
＿＿{ 線情報を取得 }
＿＿GetSegPt1(hL, x0, y0);
＿＿GetSegPt2(hL, x, y);
＿＿lnLen:= HLength(hL);
＿＿rot:= HAngle(hL);
＿＿
＿＿{ 文字を生成 }
＿＿TextJust(2);＿{Center}
＿＿TextVerticalAlign(txtVAlign);
＿＿PenFore(txtColor);
＿＿TextOrigin(x0, y0);
＿＿BeginGroup;
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿TextFont(ch_font[i]);
＿＿＿Textsize(ch_size[i]);
＿＿＿if ch_numByte[i] = 2 then
＿＿＿＿CreateText(Concat(ch_chars[i, 1], ch_chars[i, 2]))
＿＿＿else {ch_numByte[i] = 1}
＿＿＿＿CreateText(ch_chars[i, 1]);
＿＿＿ch_hnd[i]:= LNewObj;
＿＿＿SetTextStyle(ch_hnd[i], 0, ch_numByte[i], ch_style[i]);
＿＿end;{for}
＿＿EndGroup;
＿＿hG:= LNewObj;
＿＿
＿＿{ 文字間距離を取得 }
＿＿numSpc:= 0;
＿＿wd:= 0;
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿GetBBox(ch_hnd[i], x1, y1, x2, y2);
＿＿＿if (0 < i) & (i < (txtLen-1)) then begin
＿＿＿＿numSpc:= numSpc + 2*ch_numByte[i];
＿＿＿end
＿＿＿else begin
＿＿＿＿numSpc:= numSpc + ch_numByte[i];
＿＿＿end;
＿＿＿ch_wd[i]:= x2 - x1;
＿＿＿wd:= wd + ch_wd[i];
＿＿end;{for}
＿＿spc:=(lnLen - wd) / numSpc;
＿＿
＿＿{ 文字を再配置 }
＿＿x:= x0 + ch_wd[0]/2;
＿＿SetTextOrientation(ch_hnd[0], x, y0, 0, false);
＿＿for i:= 1 to txtLen - 1 do begin＿＿＿
＿＿＿x:= x + spc * (ch_numByte[i-1] + ch_numByte[i]) + (ch_wd[i-1]+ch_wd[i])/2;
＿＿＿SetTextOrientation(ch_hnd[i], x, y0, 0, false);
＿＿end;{for}
＿＿
＿＿{ 文字を回転 }
＿＿HRotate(hG, x0, y0, rot);
＿＿
＿＿{ 「.」を空白に戻す }
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿if ch_isSpace[i] then
＿＿＿＿SetText(ch_hnd[i], ' ');
＿＿end;
＿end;{if}
＿PopAttrs;
end;{main}
Run(AlignText);

文字を均等配列にするスクリプトと合わせて使えば、Macでも縦書きが出来ます。

procedure SetTextRot;
{ 文字の回転角を設定する。 }
{ アクティブレイヤの文字（グループでも可）を選択して、実行する。 }
const
＿TextObj = 10;
＿GroupObj = 11;
var
＿numText＿:integer;
＿angText＿:real;
＿countMode＿:boolean;
＿
procedure DoText(h:handle);
var
＿x, y, a＿:real;
＿flip＿:boolean;
begin
＿if countMode then begin
＿＿numText:= numText + 1;
＿end{if}
＿else begin
＿＿GetTextOrientation(h, x, y, a, flip);
＿＿SetTextOrientation(h, x, y, angText, flip);
＿end;{else}
end;{DoText}

procedure DoInGroup(hP:handle);
var
＿h＿:handle;
begin
＿h:= FInGroup(hP);
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextObj(h);
＿end;
end;{DoInGroup}

procedure DoInLayer;
var
＿h＿:handle;
begin
＿h:= FSActLayer;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿TextObj: DoText(h);
＿＿＿GroupObj: DoInGroup(h);
＿＿end;{case}
＿＿h:= NextSObj(h);
＿end;
end;{DoInLayer}

begin
＿countMode:= true;
＿numText:= 0;
＿DoInLayer;
＿＿
＿if numText = 0 then begin
＿＿AlrtDialog('文字を選択してください。');
＿end{if}
＿else begin
＿＿angText:= AngDialog('文字の角度(A) = ', '0.00°');
＿＿if not DidCancel then begin
＿＿＿countMode:= false;
＿＿＿DoInLayer;
＿＿end;{if}
＿end;{else}
end;
Run(SetTextRot);

>与太郎さん
あらら、本当ですね、スクリプト終了後には文字化けこそしませんが、テキストツールで
キャレットを入れた途端に文字化けするようです。
厳密には文字属性が変更されている位置の前や途中に1Byte文字を奇数個入れると発生する
ようですね。
しかし、文字属性を残したまま SetText を迂回してコーディングするのは現実的でない
ように思います。
他の開発ツールで同様の現象が発生した場合でも、不可能ではないですが、それでもあま
りやりたくない修正ですね

＞与太郎さん
やはり、文字はやっかいですね。通りでフォント等の指定の出来ないエディタがある訳
ですね、無理もない...。
＞陰陽師さん
カスタマイズしていると見えない壁が存在していますね...。
なかなか情報が出てこないし、少ない情報も英語だし...。

＞陰陽師さん
SetTextで文字列を変えた時、文字属性が全部同じなら問題ないですが、
文字ごとに属性を変えてる場合、文字の挿入や削除で、文字と属性の関係がずれてしまいます。
２バイト文字が化けることもあります。
例をあげると、全部２バイト文字で、途中で属性が変化している状態で、「Text編集ダイアログ」
で先頭に１バイト文字を挿入すると、属性が２バイト文字の前半と後半で変わってしまい、その
位置の文字は化けてしまいます。属性が違うので、１バイト目と２バイト目が別の文字と認識さ
れるのが原因です。

これは、VW標準の「文字検索／置換」コマンドでも起こります。

>石男さん

僕は Win VW10 ですが、縦スクロール○ 横スクロール× タブ入力× です。
スクロールについてはバグはバグでも TextEditBox コンポーネントのプロパティの設定
忘れでしょうね...ここいら辺はユーザーが設定できるというのが本来の姿ですが...
何でもかんでもパラメータで設定というのも無理があります。

そろそろVector Script の言語仕様もObject化の時期にきているのでは？ と思うのですが...
でないと近い将来、他のCADに遅れをとることになるでしょう。
そしてSDKもいいですが、いっそのことVWがOLE対応になれば他の言語からでもVector Scriptを
使うことができ、MacのToolBox やWinのAPIも利用できるんです(^-^)

>どうもです、CreateEditTextBoxにはスクロール機能がついているんですが、VW11の
>Macではこのスクロールが出てきません。また、これもMac OS10.3がらみのバグかもし
>れません。それとTab入力は出来ない模様です、これは仕様かな。

>石男さん
おはようございます、昨日はありがとうございました。
他の言語を長い間使っていて、久しぶりにVector Scriptoに触れると非常に窮屈に感じます。
でも反対に窮屈だからこそ、何とかしょうと工夫が生まれ、皆はまって行くのかも知れませんネ。(^o^)

それとText編集ダイアログのコードは、下のままでは、コマンド実行の度にセレクション
ポインタに制御が戻るので連続して編集するのに不便です。
最終行から 4行目の SetTool(-128); を2行上に上げて下記のようにして下さい。

Warning(' 　　　文字列が大きすぎます！');
SetTool(-128);
end;
SetLayerOptions(Option);
end;
Run(TextEdit);

＞陰陽師さん
どうもです、CreateEditTextBoxにはスクロール機能がついているんですが、VW11の
Macではこのスクロールが出てきません。また、これもMac OS10.3がらみのバグかもし
れません。それとTab入力は出来ない模様です、これは仕様かな。
＞与太郎さん
＞GetPolylineVertex(h, i, x, y, tp, R);
そう、これを言ってました。頂点タイプが円弧なら円弧の半径を取れるみたいな感じ
だったので試したのですが、0しか返ってきません。SDKにも似たものがあるんですが
これは確認出来ていません...。

こんばんわ陰陽師です。
石男さんに モダンダイアログの CreateEditTextBox( ) の使い方をご教授頂きました。
ありがとうございました。

VectorWorks のテキストツールは配置済みの文字列を編集する際、カーソルが狙った位置
に入らずいらいらします。
下のScriptは、配置済みの文字列をクリックして編集ダイアログに読込み同じ縮尺なら、
異なるレイヤへもジャンプして編集することができます。
皆さんにも、お使い頂ければ幸いです。

Procedure TextEdit;
const
MaxLen = 32000;
var
TextLen,Option: Integer;
ObjH: Handle;
PickedText,TextObj: DynArray[] of Char;
Result: Real;
IsText,NilHandle: Boolean;

procedure GetPickedText;
var
x,y: Real;
begin
GetPt(x,y);
ObjH := PickObject(x,y);
if ObjH<>Nil then
begin
NilHandle := False;
if GetType(ObjH) = 10 then
begin
IsText := True;
PickedText := GetText(ObjH);
TextLen := Len(PickedText);
end else
IsText := False;
end else
NilHandle := True;
end;

procedure EditDilg;
const
WChara = 60;
HChara = 15;
TextBoxID = 3;
var
DialogID: LongInt;
DlgJust: Boolean;

procedure DlgCallback(var Item,Value: Longint);
begin
Case Item of
SetupDialogC: SetField(TextBoxID,PickedText);
1: TextObj := GetField(TextBoxID);
end;
end;

begin
DialogID := CreateLayout(' テキスト 編集',False,'O K','Cancel');
CreateEditTextBox(DialogID,TextBoxID,'',WChara,HChara);
SetFirstLayoutItem(DialogID,TextBoxID);
DlgJust:=VerifyLayout(DialogID);
if DlgJust then
Result := RunLayoutDialog(DialogID,DlgCallback);
end;

procedure Warning(S: String);
begin
SysBeep;
AlrtDialog(Concat(Chr(32),Chr(10),Chr(32),Chr(10),S));
end;

begin
Option := GetLayerOptions;
SetLayerOptions(5);
GetPickedText;
if IsText & (NilHandle=False) & (TextLen<=MaxLen) then
begin
EditDilg;
if Result = 1 then
begin
SetText(ObjH,TextObj);
ReDrawAll;
end;
end else
begin
if (IsText=False) & (NilHandle=False) then
Warning(' 　文字列を指示してください！');
if (NilHandle=False)&(TextLen>MaxLen) then
Warning(' 　　　文字列が大きすぎます！');
end;
SetTool(-128);
SetLayerOptions(Option);
end;
Run(TextEdit);

石男さん、
＞本日スクリプト三昧です...。
各所で大活躍ですね。

＞曲線の円弧情報もとれない...。
GetPolylineVertex(h, i, x, y, tp, R);で返ってくるＲは設定値で、実際にその半径か
どうか判りません（これはバグではないから、新しい別の関数でないと無理でしょう。）
データパレットの「フィレット設定」では正しい半径が出るんですから、なにか方法が
あるんでしょうけど...
曲線を線分に分解して、円弧のハンドルを取って出来ないかなあ。

図面承認貰えず、本日スクリプト三昧です...。いいのか悪いのか？
＞VS関数にないSKD関数を、全部PIL化してもらえたら有難いのですが...
はい、確かにそうです。その前に、古くからある関数で引数のおかしいやつを直して
欲しいです。曲線の円弧情報もとれない...。
＞めんどくさいですね。
かなり面倒です...。

石男さん、ありがとうございます。
勉強不足でした。

＞PlugInLibraryRoutines：HScale2D();
VW10のデモ版には入ってないので、VW10.5からで間違いないようです。
小出しにせずに、VS関数にないSKD関数を、全部PIL化してもらえたら有難いのですが...

＞四角形、多角形、曲線で図面を書いてGetBBoxで最小の縦横寸法をレコードに書き出します
曲線でもなんでも計算前に多角形に変換すればいいんでしょうけど、
多角形の各辺を基準にして（辺の回数だけ）回転しないと、最小高さは得られませんね。
もしも形状が凹だったら、基準線の下に頂点があるかどうかも調べて、その点と基準線の一端を結
んだ線を基準にして多角形を回転させて...

めんどくさいですね。

「文字を均等配列にするスクリプト」は、
VW9でも動くはずだったのですが、そのままではダメなようです。
VW9.5(Mac)、VW9デモ(Win)共に、VWが落ちてしまいました。

VW10.5以降で確認したところ、PlugInLibraryRoutinesの中にこんな関数を見つけまし
た。これをつかうと大丈夫そうです。
HScale2D(h: HANDLE; centerX: REAL; centerY: REAL; scaleX: REAL; scaleY: REAL; scaleText: BOOLEAN);
ハンドル図形に対して拡大縮小をさせます。最後の引数scaleText: BOOLEANは文字に対
して実行するかということなので、これをfalseにしておいてグループ図形に対して実
行すれば均等配列が出来ますよ。

どうも思いつきません。
＞何処へ？
四角形、多角形、曲線で図面を書いてGetBBoxで最小の縦横寸法をレコードに書き出し
ます。この時、それぞれの図形が傾いていないならOKなのですが、傾いていると意味の
ない数字になってしまいます。それぞれの図形タイプ毎に条件を付けていくと...。
それで、何処へ？行ってしまいました...。

下の書き込みの均等文字列（グループ図形）の幅だけを、スクリプトで簡単に変えられないでしょうか？
手動なら問題ないのですが...
Scale()でやると、文字サイズまで変わってしまいます。

＞陰陽師さん
太っ腹！
ときどきWinのNotePadでスクリプトを書いてましたが、オートインデントすらないので不便でした。
Vector Script専用 Editor、ありがたく使わせていただきます。
みなさんに成りすましまして、お礼申し上げます。

＞石男さん
何処へ？
四角形の傾きについて、先日のは律儀に計算しましたが、多角形を水平に回転すれば四角形かどうかの
鑑定が簡単になるような気がしました。

＞ARcoatingさん
おひさです！

＞A&Bさん
どうもです。

＞陰陽師さん
すごい物を作りましたね。そのパワーには脱帽です。残念ながら私はMacなので使えな
いのですが...。
そんなMacな人にはやはり「mi」がお勧めです。A+AさんがVectorScriptモードを提供
してくれました。数年前から「mi」を愛用していますが、これで鬼に金棒です。
AppleScriptを少し分かれば「mi」のドキュメントをVectorScriptをVWで実行させるこ
とも簡単です。またテンプレートを利用するとかなり便利です。
そんな「mi」は...
http://www.mimikaki.net/

与太郎さん、石男さん、陰陽師さん。
ただ、ただ、感謝です。ありがとうございます。

>与太郎さん
いつも、すみません。2Dも条件を与えていくと段々奥が深くなっていきますね。
どうも考えているところまで行けない気がしてきました。

全部の辺の長さと角度をしらべて、幅、高さ、角度を返す関数です。

procedure test;
{$ DEBUG}
var
h:handle;
wd, ht, a:real;

function Closed(hPoly: handle): boolean;
{多角形が閉じていればTRUEを返します。}
var
fPat:integer;
begin
fPat:= GetFPat(hPoly);
SetFPat(hPoly, 0);
if HArea(hPoly) = 0 then
Closed:= false
else
Closed:= true;
SetFPat(hPoly, fPat);
end; {Closed}

function IsRectangle(h:handle; var wd, ht, ang:real):boolean;
{ 長方形の情報を返します。 }
const
PolyObj = 5;
dA = 0.0001;{degree}
var
result:boolean;
i:integer;
x, y:array[0..4] of real;
d, a:array[1..4] of real;
v:vector;
aa:real;
begin
result:= false;
if GetType(h) = PolyObj then begin
if GetVertNum(h) = 4 then begin
{if IsPolyClosed(h) then begin}
if Closed(h) then begin
for i:= 1 to 4 do
GetPolyPt(h, i, x[i], y[i]);
x[0]:= x[4]; y[0]:= y[4];
for i:= 1 to 4 do begin
d[i]:= Distance(x[i], y[i], x[i-1], y[i-1]);
v[1]:= x[i] - x[i-1]; v[2]:= y[i] - y[i-1];
a[i]:= Vec2Ang(v);
if (i = 3) | (i = 4) then begin
a[i]:= a[i] + 180;
if 180 < a[i] then
a[i]:= a[i] - 360;
end;{if}
end;{for}
if ((d[1]) = (d[3])) & ((a[1]) = (a[3])) then begin
result:= true;
aa:= a[2] - a[1] + 90;
while (180-dA) < aa do
aa:= aa - 180;
if Abs(aa) < dA then begin
wd:= d[1];
ht:= d[2];
ang:= a[2];
end;{iF}
end;{if}
end;{if}
end;{if}
end;{if}
IsRectangle:= result;
end;{IsRectangle}

begin{test}
h:= FSActLayer;
if IsRectangle(h, wd, ht, a) then
Message('Width=', wd, ' / Height=', ht, ' / Angle=', a)
else
Message('長方形ではござらん！');
end;
Run(test);

IsPolyClosed は、使えない場合もあるので、代わりにClosedを使いました。
距離の比較に「=」は、まずいかも。（誤差を考慮しないと）

1年ぶりに書き込みさせていただきます。

Vector Script専用 Editorなるものを作ってみました...
Windows版 のみなのですが Win な人は下のURLを覗いて見てください。

http://www.eonet.ne.jp/~onmyouji/VWEditor.html

四角形を傾かせると多角形になってしまいますが、それなら傾いた多角形の角度を取得
する方法ってあるんでしょうか？もしかしたら、四角形のPIOを作って...という方法し
かないんですかね？

>0,0,1とは思ってもみませんでした、、、。
マニュアルに書かれている通りにやったのでは絶対に分かりません。
たまたま、NNAのMLで見つけただけです。ホントは書き直してもらいたいところです。

こんにちは石男さん。
情報ありがとうございます！
SetViewVectorはこうやってやれば使えるのですね！！
0,0,1とは思ってもみませんでした、、、。
石男さんのご想像通り、SetViewVectorが使えなくて、
SetViewにしました、、SetViewはほんとわけわかりません、、、。
おかげさまで、視点を自由に変えられそうです！
ありがとうございました！

>ARcoatingさん
SetViewを使うと一生懸命座標計算をしなくてはならないと思いますが、SetViewVector
を使うと楽出来ます。きっとSetViewVectorが使えず、SetViewを使うはめになったので
しょうけど...。

SetViewVector( locationX , locationY , locationZ , targetX , targetY , targetZ , upX , upY , upZ ) ;

locationカメラの座標
targetview target視点の座標
up視線角度

　となっていますが、upの引数を0,0,1にしないと駄目なようです。
以下参考になれば

Procedure Test ;

Var
gCamera , gTarget : Vector ;
gLenz : Real ;
gSave : Boolean ;
{--------------------Sub-------------------}
{-------------------------Set_Projection------------------------}
Procedure Set_Projection( Lenz_Dist : Real ) ;
Var
p1X, p1Y, p2X, p2Y , Real_Offset : Real;
Begin
GetDrawingSizeRect( p1X, p1Y, p2X, p2Y );
Real_Offset := ( 25.413 * GetLScale( ActLayer ) ) * Lenz_Dist ;
Projection( 1 , 0 , Real_Offset , p1X, p1Y, p2X, p2Y );
End ;

{=================Main===================}
Begin
gLenz := 8.5 ;
gSave := false ;
GetPt( gCamera.x , gCamera.y ) ;
GetPtL( gCamera.x , gCamera.y , gTarget.x , gTarget.y ) ;
PtDialog( 'カメラとターゲットの高さを入力 X:カメラ Y:ターゲット' , '0' , '0' , gCamera.z , gTarget.z ) ;{-----------カメラとターゲットの一致には同じ高さ-------------}
If Not DidCancel Then
Begin
Locus3D( gCamera.x , gCamera.y , gCamera.z ) ;
Locus3D( gTarget.x , gTarget.y , gTarget.z ) ;
Set_Projection( gLenz ) ;

SetViewVector( gCamera.x , gCamera.y , gCamera.z , gTarget.x , gTarget.y , gTarget.z , 0, 0 , 1 ) ;

{---------画面登録----------}
If ( gSave = true ) Then
Begin
SaveSheet( 'TestView' , true, true, true ) ;
End ;
End ;
End ;
Run( Test ) ;

こんばんわ。おひさしぶりです。
ちょっと来てない間に与太郎さんすごいですね！！
大変貴重で有用なツールがたくさん！！
さっそく、使わせて頂きます！
私も、ツールではありませんが、スクリプトを書きましたので
書込みさせて頂きます。

内容はロジスティック方程式を解いて、それを図形化、
そして、作成過程をカメラを回して表示するものです。
ＱＴ書出しもついでにしますが、時間がかかるので
コメントアウトしました。


procedure fearful_symmetry;

const
＿Pai=3.141592653589793;
var
＿cA,cB,cC,cD,cK,cGyou,bairitu,copy2:real;
＿cCount,zukeiiti,copy1 : integer;
＿x,y,z,z_sita,drawX,drawY :real;
＿draw2X,draw2Y :real;
＿n,nVTR,nnVTR : integer;
＿kirimu_n1,kirimu_n2 : integer;
＿hn1,wsh : HANDLE;
＿ZArray: ARRAY[0..100,0..100] OF real;
＿{以下ビデオ用}
＿filename :string;
＿refa,abc :INTEGER;
＿frameRate :REAL;
＿keyframeRate :LONGINT;
＿xAngleR, yAngelR, zAngleR, offsetX, offsetY, offsetZ:REAL;
＿FrameCutNo :INTEGER;
＿
{__/__/__/__/__/__/__/__/__/__/ 座標計算 __/__/__/__/__/__/__/__/__/}
PROCEDURE Logistic_Equation(var xx:real; var yy:real);
var
＿x1,y1 :real;
begin
＿x1:=cA*sin(2*Pai*xx)+cB*sin(2*Pai*xx)*cos(2*Pai*yy)+cC*sin(4*Pai*xx)+cD*sin(6*Pai*xx)*cos(4*Pai*yy)+cK*xx;
＿if xx>=0 then
＿＿x1:=x1-trunc(x1)
＿＿else
＿＿x1:=x1-trunc(x1)+1;
＿y1:=cA*sin(2*Pai*yy)+cB*sin(2*Pai*yy)*cos(2*Pai*xx)+cC*sin(4*Pai*yy)+cD*sin(6*Pai*yy)*cos(4*Pai*xx)+cK*yy;
＿if yy>=0 then
＿＿y1:=y1-trunc(y1)
＿＿else
＿＿y1:=y1-trunc(y1)+1;
＿xx:=(x1+1)*50;
＿yy:=(y1+1)*50;
end;

{__/__/__/__/__/__/__/__/__/__/ 高さ(z)算出 __/__/__/__/__/__/__/__/}
PROCEDURE Z_Maker(ax,ay:LONGINT; var az:real; var bz:real);
var
＿sukima: Real;
begin
＿sukima := 0.1;
＿IF ZArray[ax,ay]<>0 THEN
＿＿begin
＿＿bz := ZArray[ax,ay]+sukima;
＿＿az := bz*bairitu+0.3;
＿＿ZArray[ax,ay] := az;
＿end else
＿＿begin
＿＿bz := sukima;
＿＿az := bz+0.3;
＿＿ZArray[ax,ay] := az;
＿end;
end;

{__/__/__/__/__/__/__/__/__/__/ ３D図形を作る __/__/__/__/__/__/__/__/}
PROCEDURE Objects3D_Maker(ax,ay:LONGINT; az,bz:real);

＿{__/__/__/__/__/__/__/ 色づけ __/__/__/__/__/__/__/__/__/__/}
＿function Fcolor(aaz:real):LONGINT;
＿var
＿＿aa: LONGINT;
＿begin
＿＿IF aaz<0.5 THEN
＿＿＿begin
＿＿＿aa := round(random*191)+48;{48-239=191}
＿＿＿Fcolor := aa;
＿＿END
＿＿ELSE BEGIN
＿＿IF (aaz>=0.50) and (aaz<1) THEN
＿＿＿begin
＿＿＿aa := round(random*95)+80;
＿＿＿Fcolor := aa;
＿＿END
＿＿ELSE BEGIN
＿＿IF (aaz>=1) and (aaz<7) THEN
＿＿＿begin
＿＿＿aa := round(random*95)+112;
＿＿＿Fcolor := aa;
＿＿END
＿＿ELSE BEGIN
＿＿＿aa := round(random*95)+144;
＿＿＿Fcolor := aa;
＿＿end;
＿＿end;
＿＿end;
＿end;

begin
＿FillBack (Fcolor(az));
＿PenFore (Fcolor(az));
＿BeginXtrd(bz, az);
＿rect(ax-0.4,ay+0.4,ax+0.4,ay-0.4);
＿EndXtrd;
end;

{__/__/__/__/__/__/__/__/__/__/ カメラの動き __/__/__/__/__/__/__/__/}
procedure Camera_Move(FcNo:INTEGER; var ARx:real; var ARy:real; var ARz:real; var OSx:real; var OSy:real; var OSz:real);
＿begin
＿＿IF (FcNo>0) and (FcNo<=30) THEN
＿＿BEGIN
＿＿＿ARx := ARx+0;
＿＿＿ARy := ARy+0;
＿＿＿ARz := ARz+0;
＿＿＿OSx := OSx+1.267;
＿＿＿OSy := OSy+0.2;
＿＿＿OSz := OSz-0.167;
＿＿END
＿＿ELSE BEGIN
＿＿IF (FcNo>30) and (FcNo<=31) THEN
＿＿BEGIN
＿＿＿ARx := ARx+43;
＿＿＿ARy := ARy+0;
＿＿＿ARz := ARz+0;
＿＿＿OSx := OSx+11;
＿＿＿OSy := OSy-18;
＿＿＿OSz := OSz+23;
＿＿END
＿＿ELSE BEGIN
＿＿IF (FcNo>31) and (FcNo<=200) THEN
＿＿BEGIN
＿＿＿ARx := ARx+0;
＿＿＿ARy := ARy+0;
＿＿＿ARz := ARz+0;
＿＿＿OSx := OSx+0;
＿＿＿OSy := OSy+0;
＿＿＿OSz := OSz-0.355;
＿＿END
＿＿ELSE BEGIN
＿＿END;
＿＿END;
＿＿END;
＿END;

{__/__/__/__/__/__/__/__/__/__/ メイン __/__/__/__/__/__/__/__/__/__/}
begin
＿wsh := ActSSheet ;
＿cGyou:=GetCellNum(wsh,28,5);
＿cA:=-0.59;
＿cB:=0.2;
＿cC:=0.1;
＿cD:=0;
＿cK:=0;
＿bairitu:=1.2;
＿zukeiiti:=1;
＿CASE zukeiiti OF
＿＿1: begin copy1:=1; copy2:=50; cCount:=10000; nnVTR:=50; end;
＿END;
＿{ビデオ設定}
＿xAngleR:=-43;
＿yAngelR:=0;
＿zAngleR:=0;
＿offsetX:=-99;
＿offsetY:=-38;
＿offsetZ:=-8;
＿{QT設定}
{＿filename := Concat('C:\Program Files\VectorWorks10J',cGyou,'.mov');}
{＿refa := 122;}
{＿abc := QTInitialize;}
{＿refa := QTOpenMovieFile(filename);}
{＿QTSetMovieOptions(refa, 12, 12, TRUE, TRUE);}
＿{Message(abc,' start_time_',Date(2,2));}

{＿LoadCell(2,1,Date(2,2));}{レンダ時間計測用}
＿x:=0.1;
＿y:=0.3;
＿for n:=1 to 20 do
＿begin
＿＿Logistic_Equation(x,y);
＿end;
＿QTWriteFrame(refa);
＿for n:=1 to cCount do
＿begin
＿＿nVTR := nVTR+1;
＿＿Logistic_Equation(x, y);
＿＿drawX := round(x);
＿＿drawY := round(y);
＿＿for kirimu_n1:=1 to copy1 do
＿＿begin
＿＿＿CASE kirimu_n1 OF
＿＿＿＿1: draw2X:=drawX;
＿＿＿＿2: draw2X:=drawX+copy2;
＿＿＿END;
＿＿＿for kirimu_n2:=1 to copy1 do
＿＿＿begin
＿＿＿＿CASE kirimu_n2 OF
＿＿＿＿＿1: draw2Y:=drawY;
＿＿＿＿＿2: draw2Y:=drawY+copy2;
＿＿＿＿END;
＿＿＿＿if (draw2X>100) or (draw2Y>100) then
＿＿＿＿begin end
＿＿＿＿else begin
＿＿＿＿Z_Maker(draw2X, draw2Y, z, z_sita);
＿＿＿＿Objects3D_Maker (draw2X, draw2Y, z, z_sita);
＿＿＿＿hn1 := LNewObj;
＿＿＿＿SetDSelect(hn1);
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿if nVTR=nnVTR then
＿＿＿begin
＿＿＿FrameCutNo := FrameCutNo+1;
＿＿＿Camera_Move (FrameCutNo, xAngleR, yAngelR, zAngleR, offsetX, offsetY, offsetZ);
＿＿＿SetView (xAngleR, yAngelR, zAngleR, offsetX, offsetY, offsetZ);
＿＿＿ReDrawAll;
{＿＿＿QTWriteFrame(refa);}{QT設定中間}
＿＿＿nVTR := 0;
＿＿END
＿＿ELSE BEGIN
＿＿end;
＿＿{Message(n);}
＿end;
{＿QTCloseMovieFile(refa);} {QT設定中間}
{＿QTTerminate;}
{＿LoadCell(2,3,Date(2,2));}{レンダ時間計測用}
＿{ClrMessage;}
end;
run(fearful_symmetry);

アクティブレイヤの文字と直線を選択して実行します。
直線を基準線にした均等配列文字（グループ図形）が出来ます。

procedure AlignText;
{ 文字を直線の長さで均等配列にする（VW9以降） }
{ アクティブレイヤの文字と直線を選択して実行 }
{$ DEBUG}
const
＿LineObj = 2;
＿TextObj = 10;
＿LF = Chr(13);
＿
type
＿charInfo = structure
＿＿numByte＿:integer;
＿＿chars＿:array[1..2] of char;
＿＿font, size, style＿:integer;
＿＿x1, x2＿:real;
＿＿hnd＿:handle;
＿＿isSpace＿:boolean;
＿end;
＿
var
＿txt＿:array[0..254] of charInfo;
＿txtLen＿:integer;
＿txtVAlign＿:integer;
＿txtColor＿:integer;
＿r, g, b＿:real;
＿i, j, n＿:integer;
＿c＿:char;
＿s＿:string;
＿h, hL, hT, hG＿:handle;
＿rot, lnLen＿:real;
＿x0, y0, x, y＿:real;
＿x1, y1, x2, y2＿:real;
＿spc, wd＿:real;
＿numSpc＿:integer;
＿
function GetNumByte(c:char):integer;
var
＿result＿:integer;
begin
＿case Ord(c) of
＿＿129..159, 224..252: result:= 2;
＿＿otherwise result:= 1;
＿end;{case}＿
＿GetNumByte:= result;
end;{GetNumByte}

begin{main}
＿PushAttrs;
＿{ 図形ハンドルを取得 }
＿h:= FSActLayer;
＿while (h <> nil) do begin
＿＿if h <> nil then begin
＿＿＿if GetType(h) = LineObj then
＿＿＿＿hL:= h
＿＿＿else if GetType(h) = TextObj then
＿＿＿＿hT:= h;
＿＿＿h:= NextSObj(h);
＿＿end;{if}
＿end;{while}
＿h:= nil;
＿
＿if (hL = nil) | (hT = nil) then begin
＿＿AlrtDialog(Concat('アクティブレイヤで、', LF,
＿＿＿'文字と直線を選択して実行してください。'));
＿end{if}
＿else begin
＿{ 文字情報を取得 }
＿＿GetPenFore(hT, r, g, b);
＿＿RGBToColorIndex(r, g, b, txtColor);
＿＿txtVAlign:= GetTextVerticalAlign(hT);
＿＿n:= GetTextLength(hT);
＿＿i:= 0;
＿＿j:= 0;
＿＿s:= GetText(hT);
＿＿while (i < n) do begin
＿＿＿c:= copy(s, i+1, 1);
＿＿＿txt[j].chars[1]:= c;
＿＿＿txt[j].font:= GetTextFont(hT, i);
＿＿＿txt[j].size:= GetTextSize(hT, i);
＿＿＿txt[j].style:= GetTextStyle(hT, i);
＿＿＿txt[j].numByte:= GetNumByte(c);
＿＿＿txt[j].chars[1]:= copy(s, i+1, 1);
＿＿＿if txt[j].numByte = 2 then
＿＿＿＿txt[j].chars[2]:= copy(s, i+2, 1);
＿＿＿if txt[j].chars[1] = ' ' then begin
＿＿＿＿txt[j].chars[1]:= '.';{ 空白の幅がゼロになる為（WinのVW10で、Macは未確認） }
＿＿＿＿txt[j].isSpace:= true;
＿＿＿end
＿＿＿else begin
＿＿＿＿txt[j].isSpace:= false;
＿＿＿end;{if}
＿＿＿i:= i + txt[j].numByte;
＿＿＿j:= j + 1;
＿＿end;{while}
＿＿txtLen:= j;
＿＿
＿＿{ 線情報を取得 }
＿＿GetSegPt1(hL, x0, y0);
＿＿GetSegPt2(hL, x, y);
＿＿lnLen:= HLength(hL);
＿＿rot:= HAngle(hL);
＿＿
＿＿{ 文字を生成 }
＿＿TextJust(2);＿{Center}
＿＿TextVerticalAlign(txtVAlign);
＿＿PenFore(txtColor);
＿＿BeginGroup;
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿TextFont(txt[i].font);
＿＿＿Textsize(txt[i].size);
＿＿＿x:= x0 + lnLen/txtLen*(i+0.5);
＿＿＿TextOrigin(x, y0);
＿＿＿if txt[i].numByte = 2 then
＿＿＿＿CreateText(Concat(txt[i].chars[1], txt[i].chars[2]))
＿＿＿else {txt[i].numByte = 1}
＿＿＿＿CreateText(txt[i].chars[1]);
＿＿＿txt[i].hnd:= LNewObj;
＿＿＿SetTextStyle(txt[i].hnd, 0, txt[i].numByte, txt[i].style);
＿＿end;{for}
＿＿EndGroup;
＿＿hG:= LNewObj;
＿＿
＿＿{ 文字間距離を取得 }
＿＿numSpc:= 0;
＿＿wd:= 0;
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿GetBBox(txt[i].hnd, txt[i].x1, y1, txt[i].x2, y2);
＿＿＿if (0 < i) & (i < (txtLen-1)) then begin
＿＿＿＿numSpc:= numSpc + 2*txt[i].numByte;
＿＿＿end
＿＿＿else begin
＿＿＿＿numSpc:= numSpc + txt[i].numByte;
＿＿＿end;
＿＿＿wd:= wd + txt[i].x2 - txt[i].x1;
＿＿end;{for}
＿＿spc:=(lnLen - wd) / numSpc;
＿＿
＿＿{ 文字を再配置 }
＿＿HMove(txt[0].hnd, x0 - txt[0].x1, 0);
＿＿for i:= 1 to txtLen - 1 do begin
＿＿＿GetBBox(txt[i-1].hnd, x1, y1, x2, y2);
＿＿＿x:= x2 + spc * (txt[i-1].numByte + txt[i].numByte);
＿＿＿HMove(txt[i].hnd, x - txt[i].x1, 0);
＿＿end;{for}
＿＿
＿＿{ 文字を回転 }
＿＿HRotate(hG, x0, y0, rot);
＿＿
＿＿{ 「.」を空白に戻す }
＿＿for i:= 0 to txtLen - 1 do begin
＿＿＿if txt[i].isSpace then
＿＿＿＿SetText(txt[i].hnd, ' ');
＿＿end;
＿end;{if}
＿PopAttrs;
end;{main}
Run(AlignText);

普通の文字図形と違って、幅を変えると文字間隔が変わります。
斜めの場合は，基準線といっしょに選択すれば、ドラッグで幅を変えられます。
環境設定で、「文字を反転禁止」にして水平反転すると、文字が逆順になります。
(意味があるか判りませんが...）

グループの中身は一文字ずつに分解されているので、文字の編集は無理です。
プラグインオブジェクトにすれば、文字の編集は出来るようになりますが、
属性（フォント、サイズ，スタイル）を文字ごとに変えられなくなります。

名前と図形タイプを、ワークシートに書き出します。

procedure ObjNameList;
{ VWの書類で使われてる名前をワークシートに書き出す。 }
{$ DEBUG}
const
＿WSName = 'Name List';
＿WSheet = 18;
＿MaxRow = 4094;
＿Clm_Name = 1;
＿Clm_TypeID = 2;
＿Clm_TypeNm = 3;
＿SQ = Chr(39);{ ' }
＿LF = Chr(13);{ 改行 }

var
＿h, hWS＿:handle;
＿name＿:string;
＿numRow, numClm＿:integer;
＿i, numName＿:integer;
＿formula＿:string;

function GetTypeName(i:integer):string;
var
＿result＿:string;
begin
＿case i of
＿＿2: result:= '直線';
＿＿3: result:= '四角形';
＿＿4: result:= '長円';
＿＿5: result:= '多角形';
＿＿6: result:= '円／円弧';
＿＿8: result:= 'フリーハンド';
＿＿9: result:= '3D 基準点';
＿＿10: result:= '文字列';
＿＿11: result:= 'グループ';
＿＿12: result:= '四分円';
＿＿13: result:= '隅の丸い四角形';
＿＿14: result:= 'ビットマップ';
＿＿15: result:= 'シンボル';
＿＿16: result:= 'シンボル定義';
＿＿17: result:= '2D 基準点';
＿＿18: result:= 'ワークシート';
＿＿21: result:= '曲線';
＿＿22: result:= 'PICT';
＿＿24: result:= '柱状体';
＿＿25: result:= '3D 多角形';
＿＿29: result:= 'リンク図形';
＿＿31: result:= 'レイヤ';
＿＿34: result:= '回転体';
＿＿38: result:= '多段柱状体';
＿＿40: result:= 'メッシュ';
＿＿41: result:= 'メッシュの頂点';
＿＿47: result:= 'レコード定義';
＿＿48: result:= 'レコード';
＿＿49: result:= 'ドキュメントスクリプト';
＿＿51: result:= 'スクリプトパレット';
＿＿56: result:= 'ワークシート図形';
＿＿63: result:= '寸法線';
＿＿66: result:= 'ハッチング定義';
＿＿68: result:= '壁';
＿＿71: result:= '柱、床、屋根';
＿＿81: result:= '光源';
＿＿82: result:= '屋根';
＿＿83: result:= '屋根';
＿＿84: result:= 'ソリッドモデラー';
＿＿86: result:= 'プラグインオブジェクト';
＿＿87: result:= 'ドーマー、スカイライト';
＿＿89: result:= '円弧壁';
＿＿92: result:= 'シンボルフォルダ';
＿＿93: result:= 'テクスチャ';
＿＿94: result:= 'クラス定義';
＿＿97: result:= 'テクスチャ定義';
＿＿95: result:= '球、半球、円錐';
＿＿111: result:= 'NURBS曲線';
＿＿113: result:= 'NURBS曲面';
＿＿119: result:= 'イメージ定義';
＿＿120: result:= 'グラデーション定義';
＿＿121: result:= 'フィル空間';
＿＿otherwise result:= '未定義';
＿end;{case}
＿GetTypeName:= result;
end;{GetTypeName}

begin{main}
＿numName:= NameNum;
＿if (MaxRow-1) < numName then begin
＿＿AlrtDialog(Concat('名前が多すぎます。 ', LF, MaxRow-1, '個以上は表示出来ません。'));
＿＿numName:=MaxRow - 1;
＿end;{if}
＿
＿{ WSを選択／作成 }
＿hWS:= GetObject(WSName);
＿if (hWS <> nil) & (GetType(hWS) = WSheet) then begin
＿＿GetWSRowColumnCount(hWS, numRow, numClm);
＿＿if (numName+1) < numRow then
＿＿＿DeleteWSRows(hWS, numRow, numRow-numName-1)
＿＿else if numRow < (numName+1) then
＿＿＿InsertWSRows(hWS, numRow, numName+1-numRow);
＿end{if}
＿else begin
＿＿name:= WSName;
＿＿i:= 0;
＿＿while (hWS <> nil) do begin
＿＿＿i:= i + 1;
＿＿＿name:= Concat(WSName, '-', Num2Str(0, i));
＿＿＿hWS:= GetObject(name);
＿＿end;{while}
＿＿if hWS = nil then
＿＿＿hWS:= CreateWS(name, numName+1, Clm_TypeNm);
＿＿SetWSCellFormula(hWS, 1, Clm_Name, 1, Clm_Name, '名前');
＿＿SetWSCellFormula(hWS, 1, Clm_TypeID, 1, Clm_TypeID, '図形タイプ');
＿end;{else}
＿
＿{ WSに記入 }
＿for i:= 1 to numName do begin
＿＿name:= Index2Name(i);
＿＿formula:= Concat('=', SQ, name, SQ);
＿＿SetWSCellFormula(hWS, i+1, Clm_Name, i+1, Clm_Name, formula);
＿＿h:= GetObject(name);
＿＿formula:= Num2Str(0, GetType(h));
＿＿SetWSCellFormula(hWS, i+1, Clm_TypeID, i+1, Clm_TypeID, formula);
＿＿formula:= Concat(':', GetTypeName(GetType(h)));
＿＿SetWSCellFormula(hWS, i+1, Clm_TypeNm, i+1, Clm_TypeNm, formula);
＿end;{for}
＿ShowWS(hWS, true);
end;{main}
Run(ObjNameList);

ファイル名とレイヤ名は別扱いのようで、名前のリストには入っていません。
でも、クラス名は入っています。（入ってなくてもいいと思うんですが）
仕事で作ったファイルだと、名前がたくさん付いてるのが判ります。
あと、名前を消すと、そのindexは新しく名前が付けられたときのために空い
たままになるようです。

「ワークシートの文字を（図面に）描く」の逆バージョンです。
図面上でクリックした文字を、ワークシートの選択セルにコピーします。
文字属性はコピーしません。

SetWSSelection で警告を出さなくする方法がわからなかったので、SetPref(21, false); で
環境設定の「VectorScriptの警告を表示」をOFFにしています。
というか、実行中にわざと警告を出すようなスクリプトもあるので、デバッグ中でなければ
「VectorScriptの警告を表示」させないほうが良いようです。

procedure CopyText2SelCell;{ 選択セルに、クリックした文字をコピーします。(VW9以降対応) }
{$ DEBUG}
const
＿TextObj = 10;
var
＿hWS, hTx, h, h0＿:handle;
＿row, maxRow, row0,
＿clm, maxClm, clm0,
＿top, left,
＿topSub, bottom, right, botSub＿:integer;
＿x, y＿:real;
＿str＿:string;
begin
＿hWS:= ActSSheet;
＿if hWS = nil then begin
＿＿AlrtDialog('ワークシートを開いてください。');
＿end{if}
＿else begin
＿＿SetPref(21, false);{ 環境設定の「VectorScriptの警告を表示」をOFFにする }
＿＿DSelectAll;
＿＿GetWSRowColumnCount(hWS, maxRow, MaxClm);
＿＿GetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿row0:= row;
＿＿clm0:= clm;
＿＿Message('文字をクリックしてください。　空クリックで終了します。');
＿＿GetPt(x, y); h:= PickObject(x, y);
＿＿h0:= h;
＿＿if (h = nil) | (GetType(h) <> TextObj) then begin
＿＿＿AlrtDialog('文字をクリックしてください。');
＿＿end{if}
＿＿else begin
＿＿＿if (top = bottom) & (left = right) then begin
＿＿＿＿top:= 1; Left:= 1; bottom:= maxRow; right:= maxClm;
＿＿＿＿SetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿＿end;
＿＿＿repeat
＿＿＿＿str:= GetText(h);
＿＿＿＿SetWSCellFormula(hWS, row, clm, row, clm, str);
＿＿＿＿clm:= clm + 1;
＿＿＿＿if clm > right then begin
＿＿＿＿＿clm:= left;
＿＿＿＿＿row:= row + 1;
＿＿＿＿＿if row >bottom then begin
＿＿＿＿＿＿row:= top;
＿＿＿＿＿end;{if}
＿＿＿＿end;{if}
＿＿＿＿SetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿＿＿DSelectObj(h0);
＿＿＿＿h0:= h;
＿＿＿＿SetSelect(h);
＿＿＿＿ReDraw;
＿＿＿＿if (row = row0) & (clm = clm0) then begin
＿＿＿＿＿h:= nil;
＿＿＿＿end{if}
＿＿＿＿else begin
＿＿＿＿＿GetPt(x, y);
＿＿＿＿＿h:= PickObject(x, y);
＿＿＿＿end;{else}
＿＿＿until (h = nil) | (GetType(h) <> TextObj);
＿＿end;{else}
＿＿ClrMessage;
＿end;{else}
end;
Run(CopyText2SelCell);

これで「図面の中の表をワークシート化するスクリプト」の何パーセントかは実現したかなぁ？

このスクリプトを作るには、Excelで座標計算をして結果をスクリプトにするのと、
普通にスクリプトを書くのと、２つの方法があります。

1. Excelでスクリプト（3D多角形生成文）を書く方法です。
3D多角形を作るスクリプトは、Poly(X1, Y1, Z1, X2, Y2, Z3...Xn, Yn, Zn); です。
まずはExcelに下のようなデータを打ち込みます。

角度　R　 H
0　　0　 60
30　 2　 55
60　 4　 50
90　 6　 45
120　8　 40
150　10　35
180　12　30
210　14　25
240　16　20
270　18　15
300　20　10
330　22　 5
360　24　 0

上のデータから、座標を計算して下のスクリプトを作ります。（度とラジアンに注意）
Excelなら簡単に出来ます。VWのワークシートでも可能です。

Poly3D(
0.00 , 0.00 , 60.00 ,
1.73 , 1.00 , 55.00 ,
2.00 , 3.46 , 50.00 ,
0.00 , 6.00 , 45.00 ,
-4.00 , 6.93 , 40.00 ,
-8.66 , 5.00 , 35.00 ,
-12.00 , 0.00 , 30.00 ,
-12.12 , -7.00 , 25.00 ,
-8.00 , -13.86 , 20.00 ,
0.00 , -18.00 , 15.00 ,
10.00 , -17.32 , 10.00 ,
19.05 , -11.00 , 5.00 ,
24.00 , 0.00 , 0.00 );

2. 普通にPascal形式のスクリプトを書きます。
ダイアログやワークシートでパラメータを設定するスクリプトは長くなるので、
ここではスクリプトの定数を直接書き換えて設定を変えます。

Procedure Spiral;
{ 螺旋形の3D多角形を作ります }
{ パラメータはconstで設定します }
const{ ここでパラメータを設定します }
StartA = 0; { 開始角度 }
EndA = 360; { 終了角度 }
StartR = 0; { 開始半径 }
EndR = 24; { 終了半径 }
StartH = 60; { 開始高さ }
EndH = 0; { 終了高さ }
N = 12; { 分割数 }
var
x, y, z:real;
dA, a:real;
dR, r:real;
dH:real;
i:integer;
begin
dA:= (EndA - StartA) / N;
dR:= (EndR - StartR) / N;
dH:= (EndH - StartH) / N;
BeginPoly3D;
for i:= 0 to N do begin
a:= Deg2Rad(StartA + i * dA);
r:= StartR + i * dR;
x:= r * Cos(a);
y:= r * Sin(a);
z:= StartH + i * dH;
Add3DPt(x, y, z);
end;{while}
EndPoly3D;
end;
Run(Spiral);

スクリプトが出来たら、VWのリソースパレット／プラウザでVectorScriptコマンドを作って、
VectorScriptエディタにスクリプトを貼り付けます。
上の右側にあるコンパイル・ボタンを押して、エラーが出なければＯＫです。
定数を変えたりスクリプトを貼りかえるときは、コマンドパレット上のコマンドを、Alt／option
キーを押してダブルクリックします。VectorScriptエディタが開きます。

下の書き込みのスクリプトでＷＳを作って、線幅の数字を変えてから実行してください。

procedure SetClassLW;
{ クラスの線幅をワークシートで設定した値に設定します。 }
{$ DEBUG}
const
＿WSName = 'Class LW List';
＿WSheet = 18;
＿ClmCls = 1;
＿ClmLW = 2;
＿LF = Chr(13);{ 改行 }
var
＿hWS＿:handle;
＿name＿:string;
＿maxRow, maxClm＿:integer;
＿i, wd＿:integer;

begin{main}
＿hWS:= GetObject(WSName);
＿if (hWS = nil) | (GetType(hWS) <> 18) then begin
＿＿AlrtDialog(Concat('「', WSName, 'というＷＳがありません。',
＿＿＿ LF, 'ＷＳの名前を変えるか、新しいＷＳを作ってください。'));
＿end{if}
＿else begin
＿＿GetWSRowColumnCount(hWS, maxRow, maxClm);
＿＿for i:= 2 to maxRow do begin
＿＿＿GetWSCellString(hWS, i, ClmCls, name);
＿＿＿wd:= Round(GetCellNum(hWS, i, ClmLW));
＿＿＿SetClLW(name, wd);
＿＿end;{for}
＿＿ShowWS(hWS, true);
＿end;{else}
＿
end;{main}
Run(SetClassLW);

クラスの線色や面属性を再設定するように修正するのも簡単そうです。

VW談話室より。
＞壁や柱とかのクラスごとに線の太さをそのつど変更しています。
スクリプトで一度に変更してみましょうか。
まず、クラスごとの線幅をＷＳに書き出してみます。

procedure CreateClassLWList;
{ クラスの線幅をワークシートに書き出します。 }
{$ DEBUG}
const
＿WSName = 'Class LW List';
＿WSheet = 18;
＿ClmCls = 1;
＿ClmLW = 2;
＿SQ = Chr(39);{ ' }
var
＿hWS＿:handle;
＿name＿:string;
＿maxRow, maxClm＿:integer;
＿i, nC＿:integer;
＿formula＿:string;

begin{main}
＿nC:= ClassNum;
＿
＿{ WSを選択／作成 }
＿hWS:= GetObject(WSName);
＿if (hWS <> nil) & (GetType(hWS) = 18) then begin
＿＿GetWSRowColumnCount(hWS, maxRow, maxClm);
＿＿if (nC+1) < maxRow then
＿＿＿DeleteWSRows(hWS, maxRow, maxRow-nC-1)
＿＿else if maxRow < (nC+1) then
＿＿＿InsertWSRows(hWS, maxRow, nC+1-maxRow);
＿end{if}
＿else begin
＿＿name:= WSName;
＿＿i:= 0;
＿＿while (hWS <> nil) do begin
＿＿＿i:= i + 1;
＿＿＿name:= Concat(WSName, '-', Num2Str(0, i));
＿＿＿hWS:= GetObject(name);
＿＿end;{while}
＿＿if hWS = nil then
＿＿＿hWS:= CreateWS(name, nC+1, 2);
＿＿SetWSCellFormula(hWS, 1, ClmCls, 1, ClmCls, 'Class名');
＿＿SetWSCellFormula(hWS, 1, ClmLW, 1, ClmLW, '線幅');
＿end;{else}
＿
＿{ WSに記入 }
＿for i:= 1 to nC do begin
＿＿name:= ClassList(i);
＿＿formula:= Concat('=', SQ, name, SQ);
＿＿SetWSCellFormula(hWS, i+1, ClmCls, i+1, ClmCls, formula);
＿＿formula:= Num2Str(0, GetClLW(name));
＿＿SetWSCellFormula(hWS, i+1, ClmLW, i+1, ClmLW, formula);
＿end;{for}
＿ShowWS(hWS, true);
end;{main}
Run(CreateClassLWList);

他の図形と同じように、レイヤもスクリプトで削除できます。

procedure DelLayer;
{ アクティブレイヤを（空なら）削除します。 }
{ アクティブレイヤが空でないか、レイヤがひとつしかない場合は削除しません。 }
var
hAL, hL:handle;
name:string;
begin
hAL:= ActLayer;
name:= GetLName(hAL);
hL:= FLayer;
while (hL <> nil) & (hL = hAL) do
hL:= NextLayer(hL);
if hL <> nil then begin
if NumObj(hAL) = 0 then begin
Layer(GetLName(hL));
DelObject(hAL);
AlrtDialog(Concat('レイヤ「', name, '」を削除しました。'));
end{if}
else begin
AlrtDialog(Concat('レイヤ「', name, '」は空でないので削除しません。'));
end;{else}
end{if}
else begin
AlrtDialog(Concat('他にレイヤがないので、レイヤ「', name, '」は削除出来ません。'));
end;{else}
end;
Run(DelLayer);

アクティブレイヤの情報を表示します。

procedure MsgLayerInfo;
{ メッセージウインドウにアクティブレイヤの情報を表示します。 }
var
＿hL＿:handle;
＿vis＿:integer;
＿lVis＿:string;
＿ht, dHt＿:real;
＿xA, yA, zA＿:real;
＿xD, yD, zD＿:real;
begin
＿hL:= ActLayer;
＿vis:= GetLVis(hL);
＿case vis of
＿＿0: lVis:= 'ShowLayer';
＿＿2: lVis:= 'GrayLayer';{ ※注意 }
＿＿-1: lVis:= 'HideLayer';{ ※注意 }
＿end;{case}
＿GetZVals(ht, dHt);
＿GetView(xA, yA, zA, xD, yD, zD);
＿Message(GetLScale(hL), ' : S=1/', GetLScale(hL),
＿＿' (', lVis, ') : H=', ht, ' : dH=', dHt,
＿＿' : xA=', xA, ' : yA=', yA, ' : zA=', zA,
＿＿' : xD=', xD, ' : yD=', yD, ' : zD=', zD);
end;
Run( MsgLayerInfo);

残念ながら、レイヤの表示モードとカラー属性はVSでは取得できません。

※注意：GetLVisの返り値が、VW9までのマニュアルでは間違っています。
マニュアル→ 表示：0 ／グレイ表示：1 ／非表示：2
正しくは　→ 表示：0 ／グレイ表示：2 ／非表示：-1
VW10でも、スクリプトエディタの「手続き／関数...」の中の説明は間違っています。

つぎに、レイヤ情報をファイルに書き出してみます。
書き出すだけでは芸がないので、他のファイルで読み込んで同じレイヤを作れるようにします。

procedure GetLayerInfoAsScript;
{ VWフォルダの「Output.txt」にレイヤ生成のスクリプトを書き出します。 }
const
＿SQ = Chr(39);
var
＿hL, hAL＿:handle;
＿name＿:string;
＿scale＿:real;
＿vis＿:integer;
＿ht, dHt＿:real;
＿xA, yA, zA＿:real;
＿xD, yD, zD＿:real;

{ AddSQ関数は、ここに書いてください。前の書き込みにあります。 }

begin{main}
＿hAL:= ActLayer;
＿hL:= FLayer;
＿while hL <> nil do begin
＿＿{ レイヤ情報を取得する。 }
＿＿name:= GetLName(hL);{ 必要なら name:= AddSQ(GetLName(hL)); に書き換えてください。 }
＿＿scale:= GetLScale(hL);
＿＿vis:= GetLVis(hL);
＿＿Layer(name);
＿＿GetZVals(ht, dHt);
＿＿GetView(xA, yA, zA, xD, yD, zD);
＿＿
＿＿{ スクリプトを書き出す。 }
＿＿WriteLn('Layer(', SQ, name, SQ, ');');
＿＿WriteLn('SetScale(', Scale, ');');
＿＿case vis of
＿＿＿0: WriteLn('ShowLayer;');
＿＿＿2: WriteLn('GrayLayer;');
＿＿＿-1: WriteLn('HideLayer;');
＿＿end;{case}
＿＿WriteLn('SetView(', xA, ', ', yA, ', ', zA, ', ', xD, ', ', yD, ', ', zD, ');');
＿＿if (xA = 0) & (yA = 0) & (zA = 0) then
＿＿＿WriteLn('DoMenuTextByName(''Standard Views'', 1);');{ ビューが「真上から」の場合は2D表示に設定 }
＿＿WriteLn;
＿＿
＿＿hL:= NextLayer(hL);
＿end;{while}
＿
＿{ アクティブレイヤを元にもどす。 }
＿Layer(GetLName(hAL));
＿name:= GetLName(hAL);
＿WriteLn('Layer(', SQ, name, SQ, ');');
end;{main}
Run(GetLayerInfoAsScript);

「Output.txt」の中身はスクリプトになっていますので、VectorScriptとして取り込むか、
コマンドを作って貼り付ければ、別のファイルに同じ名前／縮尺／高さ／ビューのレイヤが
作れます。

書いてて思ったのですが，チャンクメニューの選択項目をVSから調べる方法はないですかね？

アクティブレイヤだけなら、こんな風にできます。

Message(GetLName(ActLayer), ' : Objects = ', NumObj(ActLayer));

グループ内の図形もカウントするなら、下のようになります。

procedure MsgObjNum;
var
name:string;
begin
name:= GetLName(ActLayer);
Message(GetLName(ActLayer), ' : Objects = ', Count(L=name));
end;
Run(MsgObjNum);

各レイヤの図形数を調べます。何かの役には立つでしょう。

procedure GetObjNum;
{ 各レイヤの図形数を「Output.txt」に書き出します。 }
{ グループ図形の中の図形はカウントされません。 }
var
＿hL＿:handle;
begin
＿Write('Layer'); Tab(1);
＿WriteLn('Objects');
＿hL:= FLayer;
＿while hL <> nil do begin
＿＿Write(GetLName(hL)); Tab(1);
＿＿WriteLn(NumObj(hL));
＿＿hL:= NextLayer(h);
＿end;{while}
end;
Run(GetObjNum);


procedure ObjNumList;
{ 各レイヤの図形数をワークシートに書き出します。 }
{ グループ図形の中の図形もカウントされます。 }
{ WSメニューの「再計算」で表示を更新できます。 }
{$DEBUG}
const
＿WSName = 'Object Num List';
＿WSheet = 18;
＿ClmLyr = 1;
＿ClmNum = 2;
＿SQ = Chr(39);{ ' }
var
＿hWS, hL＿:handle;
＿name＿:string;
＿row, clm＿:integer;
＿i, nL＿:integer;
＿formula＿:string;

function AddSQ(s:string):string;
{ 名前の中の「'」を「'」+「'」 に直します。 }
var
＿result＿:string;
＿i, j, lng＿:integer;
begin
＿result:= s;
＿lng:= Len(result);
＿i:= 1;
＿while (i <= lng) do begin
＿＿if Copy(result, i, 1) = SQ then begin
＿＿＿result:= Concat(Copy(result, 1, i), SQ, Copy(result, i+1, lng-i));
＿＿＿lng:= lng + 1;
＿＿＿i:= i + 2;
＿＿end{if}
＿＿else begin
＿＿＿i:= i + 1;
＿＿end;{else}
＿end;{while}
＿AddSQ:= result;
end;{AddSQ}

begin{main}
＿nL:= NumLayers;
＿
＿{ WSを選択／作成 }
＿hWS:= GetObject(WSName);
＿if (hWS <> nil) & (GetType(hWS) = 18) then begin
＿＿GetWSRowColumnCount(hWS, row, clm);
＿＿if (nL+1) < row then
＿＿＿DeleteWSRows(hWS, nL+1, row-nL-1)
＿＿else if row < (nL+1) then
＿＿＿InsertWSRows(hWS, row, nL+1-row);
＿end{if}
＿else begin
＿＿name:= WSName;
＿＿i:= 0;
＿＿while (hWS <> nil) do begin
＿＿＿i:= i + 1;
＿＿＿name:= Concat(WSName, '-', Num2Str(0, i));
＿＿＿hWS:= GetObject(name);
＿＿end;{while}
＿＿hWS:= CreateWS(name, nL+1, 2);
＿＿SetWSCellFormula(hWS, 1, ClmLyr, 1, ClmLyr, 'Layer');
＿＿SetWSCellFormula(hWS, 1, ClmNum, 1, ClmNum, 'Objects');
＿end;{else}
＿
＿{ WSに記入 }
＿i:= 0;
＿hL:= FLayer;
＿while hL <> nil do begin
＿＿i:= i + 1;
＿＿name:= GetLName(hL);{ ※注意 }
＿＿formula:= Concat('=', SQ, name, SQ);
＿＿SetWSCellFormula(hWS, i+1, ClmLyr, i+1, ClmLyr, formula);
＿＿formula:= Concat('=Count(L=', SQ, name, SQ, ')');
＿＿SetWSCellFormula(hWS, i+1, ClmNum, i+1, ClmNum, formula);
＿＿hL:= NextLayer(hL);
＿end;{while}
＿ShowWS(hWS, true);
end;{main}
Run(ObjNumList);

※注意：レイヤ名に「'」が含まれているときは、下のようにしないと表示できません。
＿＿name:= GetLName(hL);{ ※注意 }
＿＿　↓
＿＿name:= AddSQ(GetLName(hL));

＞石男さん
クラシック（環境）はダメですか？
与太郎はResEdit、Resorcererはクラシック環境です。

＞Mac OS9でResEditを使うのも最近は嫌気がさしてきました
Mac OS9で起動し直すのが嫌で嫌で...、ResFoolは編集するにはいいのだけど...。
結局、Mac OS9でResEditがベストなのかな〜。Resorcererは高過ぎ！

＞リソース編集をみなさんは何を使っているのでしょうか？
ResEditとResorcerer2.0（古！）ですが、
最近ほとんど使ってなくて、ResEditでファイルタイプを直したり、VWのダイアログを広げる程度。

＞Mac OS9でResEditを使うのも最近は嫌気がさしてきました
OS9とResEditのどちらがイヤでしょうか？
'STR#'リソースとかを大量に作るのなら、リソースエディタよりリソースコンパイラのほうが楽
かもしれません。（どこで入手するかが問題ですが）

最近SDKについて調べてましたが、Plug-in Libraryを作れば、SDKの関数をVSから使えるようです。
例のIsPolyClosedは、SDKのGetPolyShapeCloseを呼んでるだけのような気がします。
GetProjection、GetDashPatというSDK関数を呼ぶPlug-in Libraryを作れば、VSの中でレイヤの表
示状態（2D or 3D）や破線間隔を知ることができるのですが、
CodeWarriorは古いのしか持ってないし...
CodeWarriorの新しいの高価いし！！
年貢の納め時ですし...
というわけで、今まで粘ってみましたが、来週V-Upしますよ。

リソース編集をみなさんは何を使っているのでしょうか？
MacWinでは違うはずですが、Mac OS9でResEditを使うのも最近は嫌気がさしてきました
Mac OSXでリソースラとなるんでしょうが、リソースラは高いし...。
OSXで使えるResFoolっていうこともあるんですが、これはイマイチです。

＞MacOS9の環境とResEdit使いなら
古いリソースラで直接Excelに（50回くらい）コピペして、マクロの自動記録／実行で
説明文をB列に移動&１行削除。バージョン情報のテーブルを別のシートに作って、
VLOOKUPで参照しました。
コピペよりスクリプトのほうが楽そうですね。

＞このPDFの大元は、与太郎が使ったのとおなじものかも。
MacOS9の環境とResEdit使いなら、分かります...。
コピーしたrsrcファイルをPlugInsに入れておき、GetResourceStringでリソースを取り
出しtxtファイルに項目毎吐き出します。それでtxtファイルをpdfにしたらまとめる。
ついでにVersion毎の関数も1つのtxtファイルにしておき、検索しながら...っていう感
じで作りました。
こうやれば1日程度で出来ます...、ただ2、3日考えましたが。

以前自作しようと思ってファイル形式の情報を探したのですが、結局見つけられません
でした。でも、バイナリ形式で単精度浮動小数点データを書き出さないといけないとし
たら、VSでは難しいですね。どちらかといえばSDK向きでしょうか。VSだと破線間隔を
得る方法がないのもネックです。
その辺をクリアすれば、書き出す図形の種類は直線、円弧、文字くらいなので、不可能
ではないと思いましたが。

石男さん、毎度ありがとうございます。m(_._)m
このPDFの大元は、与太郎が使ったのとおなじものかも。

＞使い慣れたExcelで作ってみます
ひとつの関数がExcelの１行に収まるようにしたら、セル内で改行してるので、テンプ
レートがうまく選択できないPDFになってしまいました（セル内の複数行をいっしょに
選択できない、隣のセルの同じ行が選択範囲になる）。単語の途中に改行があると、そ
の語も検索も完全ではないし。これはExcelのままか、印刷して使ったほうがよさそう。

あと、PDFマニュアルってA4縦のレイアウトが多いのですが、画面で見るときは（モニ
タが1024x768だと）都合が悪いので、A4横にしています。

＞スクリプト・エディタの関数／手続きの一覧みたいなものがPDF
を作ってみました、各関数の初出バージョン付きです。一応、カテゴリ分けもしてあり
ます。以下のところからDLしてください。各自の判断でお使いください。
http://ric.shokokai.or.jp/tochigi/Html/0940710086/index.htm
なお、Macでのみ確認しています。

>JW取り出し
は日本仕様でしょうから、カスタマイズは無理です。基本的に「××××取り出し」は
VSのみでの制御は不可です。AppleScriptを併用しないと制御は出来ません。
今のところVWにVisualBasicが対応していませんのでWinでは無理です。
となると、自力でＪＷが読めるファイルを作る...ってなりますが。現実的ではないで
しょう...。

はじめてスクリプトを勉強しようと思うのですが、
ＪＷ取り出しコマンドをカスタムできるものでしょうか？
具体的に、、
�@取り出しについての各変換設定(色・線種等)を保存できるようにする。
�AＶＷ側図形の色(寸法・文字含む)をそのまま変換できるようにする。
、、上記の事はできそうでしょうか？
よろしければどなたか道筋があれば教えてもらいたく書き込みました。
どこから手をつけてよいものか、、、困った今日この頃です。

＞html にして、ついでにテスト結果や、気が付いた事を追加して使っています。
マニュアルが上書き可能なら、そういう使い方も出来ますね。
使い慣れたExcelで作ってみます。

PDFレフェレンスは日本仕様だったため、今後は出てこない可能性がありますよ。
わたしも皆さん同様にhtml〜PDFに変換したりしていましたが、もう最近はあきらめて
htmlでやっています。しかも、翻訳を当てにしないで原文の方で...。

同感です。今のマニュアルは関数の内容が理解できていなければ、とても利用できません。
私は個別に分けられた html の Rederence を全て合体して１つの html にして、ついでにテスト
結果や、気が付いた事を追加して使っています。
編集に手間がかかり、ファイル容量は 2.43MB と大きくなりましたが「こんな事ができないか？」
ってな時に、以前のように簡単に単語で検索が出来てとても便利です。
でも、検索する時に間違えて「編集」→「すべて選択」と実行した時は大変です。すべて選択する
まで数分間待たされます（泣）。
また、バージョンアップの度に新規に増えた関数分を編集（合体）しなければならないので、
これも苦の種です。

エーアンドエーさん、全体から検索できる機能をつけて下さい。それが出来なければもとのリファ
レンスに戻してください。お願いします。

VW9.5までのVS ReferenceマニュアルはPDFなので、OS10.3のPreviewで快適に
検索できて良いのですが、VW10からはhtmlマニュアルしかありません。
htmlマニュアルって、ファイルがカテゴリー別に分かれてるので、
マニュアル全体から単語を検索できなくて不便です。
それで、htmlマニュアルをPDF化できないかと、春ごろから暇をみては作って
いたんですが、いつの間にか忘れてました。それを先日あらためて見たら、
改行位置が変だし、文字サイズがばらばらで、見栄えが良くなかったです。
（ページ数も無駄に多かったし...）

詳しい説明はいらないから、もっとコンパクトなマニュアル（というか関数／
手続きの一覧）を、A&Aで作ってもらえれば一番なんですが。
スクリプト・エディタの関数／手続きの一覧みたいなものがPDFになっていれ
ばいいんです。どのバージョンに対応してるかの情報も付いてたら助かります。
VW11に付いてるということはありませんよね？

＞石男さん、
データの中でカンマ、スペースを使う（かもしれない）ので、タブ区切りに拘っておりますです。

＞masafumiさん、
私も意外でした。思い付く限り、最も簡単で早い方法とは思ってましたが。(^O^)V
条件を同等にするために、関数呼び出しにしてみましたが、ほとんど同じ結果でした。

＞タブ区切りファイルの Read、ReadLn でトラブってしまいました。
私も経験ありです、結局タブ区切りをやめてカンマ区切りに変更していまいました。

＞IsPolyClosed() 関数
これはSDKの関数をそのまま利用しているのでかなり違いが出ると思いますよ。

下記は　IsPolyClosed() 関数と、与太郎さんに教えて頂いた方法で、実行時間を
比較してみました・・・。こんなに差が有るとは・・・。（脱帽！ m(_ _)m）


{*********** 多角形の開閉チェック（その１） **********}
procedure IsPolyClosed_Test;
var
i :Integer;
objH :Handle;
closeFlg :Boolean;
tick1,tick2:Longint;
ret :Longint;
msg :String;
begin
tick1:=GetTickCount;
for i:=1 to 2000 do
begin
closeFlg:=True;
objH:=FSActLayer;
ret:=GetFPat(objH);
SetFPat(objH, 0);
if (HArea(objH)=0) then closeFlg:=False;
SetFPat(objH, ret);
end;
tick2:=GetTickCount;
msg:=Concat('時間＝ ',(tick2-tick1));
AlrtDialog(msg);
end;
run(IsPolyClosed_Test);


{*********** 多角形の開閉チェック（その２） **********}
procedure IsPolyClosed_Test;
var
i :Integer;
objH :Handle;
closeFlg :Boolean;
tick1,tick2:Longint;
msg :String;
begin
tick1:=GetTickCount;
for i:=1 to 2000 do
begin
objH:=FSActLayer;
closeFlg:=IsPolyClosed(objH);
end;
tick2:=GetTickCount;
msg:=Concat('時間＝ ',(tick2-tick1));
AlrtDialog(msg);
end;
run(IsPolyClosed_Test);

性懲りもなく、タブ区切りファイルの Read、ReadLn でトラブってしまいました。
少々手を抜こうとしたら、余計に時間がかかったという、最悪のパターンです。
Read、ReadLn が、文字列の先頭のスペースを無視してしまうのが原因だったのですが...

「文字列1+タブ+空白+文字列2」の行を読み込んだ場合、
文字列1 と スペース+文字列2 を取得したいのですが、 タブ+スペース を一つのセパレータと認識するので、
文字列1 と 文字列2 が返ってきます。

また、「文字列1+タブ+タブ+文字列3」を読ませて、文字列1、文字列2（ヌル）、文字列3 を得るつもりでも、
２つのタブが一つのセパレータとなるので、途中で読み込む順番がずれてしまうことも判りました。

行ごとにデータの数が違ってたり、途中に空白データがあったり、スペースで始まる文字列データを含んだ
タブ区切りファイルは、Read、ReadLnでは無理があるようです。
以前書き込んだように、StdReadlnで一行全部読み込んで、自分でタブごとに分割する必要があります。
Read、ReadLn の仕様を理解せずに使ったため、余計な苦労をしてしまいました。マニュアルに詳しく書いて
あれば良かったのですが...。

＞masafumiさん、
多角形の開閉状態は、SetFPat(h, 0); A:=HArea(h);で面積を調べれば判ります。
図形のロック状態は、GetBBox()で座標を調べて、HMove()の後の座標と比べてみれば判ります。
どちらも調べた後、最初の状態に戻しまときます。
こんな関数は標準で用意してよ、って思います。あと、レイヤが2D表示か3D表示かを調べる関数も。

ところで、
メッシュ図形の頂点の図形タイプ番号が定義されてるのですが、頂点のハンドルを取得して、座標を調べたり、
頂点を移動したり出来るのでしょうか？

＞IsPolyClosed(polyHandle: HANDLE) : BOOLEAN;
これってかなり前からあります、実は...。
これらの外部関数はNNAのMLにでも質問しないかぎり説明は出ない気がします。

＞VWPluginLibraryRoutines.p

こんな関数も有るんですね。

IsPolyClosed(polyHandle: HANDLE) : BOOLEAN;

ポリラインの開閉状態を知ることができる関数のようです。（＾＿＾）ｖ

変更日時順で表示させると、一番上にありました。 ＞ VWPluginLibraryRoutines.p
でも、VW起動or終了のたびに更新されてるようで、不思議です。

＞さらにvst...なんたらかんたらと言ったものまで...これはわかりません。
NNAが説明出すまでお預けということですね。社内(NNA)用の関数なのかもしれません。

ところで、
古いスクリプト（8.5用）を10.5で使おうとしたら、思ったとおりに動かず、半日悩んでしまいました。
GetClassOptionsの戻り値が変更されてるのが原因でした。（8.5→9で変更）エラーが出ないので，原
因を見つけるのが大変でした。
定数を外部参照ファイルにして、{$INCLUDE XXX.vss}で参照すれば、バージョンの違いに対処しやすい
と思いますが、エラーが出てうまくいきません。で、結局スクリプト本体に直接書いちゃうんですよね。

Plug-Insフォルダ内にあるVWPluginLibraryRoutines.p（スペル違いの時はご容赦）を
ご覧下さい。テキストエディタで開けます。
ネメチェック、A+Aの隠しVSが登録されています。これを見ると10.5にはvso...といっ
た一連のものはないんですよ。11にはありますが、さらにvst...なんたらかんたらと
言ったものまで...これはわかりません。

＞（大層面倒そうだけど）
結構、凝ると面倒です。ただ新機能のサンプルが全然ないし資料もないので...。

やっぱり10.5では無理でしたね。＞「PIOのデータパレットにプッシュボタンを付ける」
VW10.5にはPIOでイベントを受け取るオプションはあるのに（機能はしてないのかも知れませんが）、
イベントを受け取る関数がありません。だから出来ないということです。
VW11のVSRefマニュアルにも、SetObjPropVS、VSOGetEventInfo、VSOAppendWidget、VSOInsertWidget、
VSOInsertAllParams等の項目はありませんが、VW11ではそれらの関数はちゃんと使えるんですよね。
追加機能だからマニュアルにないのでしょうか。
そういえば、HiBaseの関数も、マニュアルに載ってませんけど。（一度どこかで見たはずですが...）

仕方がないのでVW11デモ版で試したら、ちゃんと動きました。感想はというと...
ボタンを付けることよりも、ボタンを押して出てくるもの（モダンダイアログに貼り付けたパターン
選択メニュー）のほうに目が行ってしまいました。
モダンダイアログは使ったことがありませんが、色々面白いことが出来そうなので、勉強してみよう
かな。（大層面倒そうだけど）

石男さん、早速ありがとうございます。

眺めましたところ、英語の説明もなんとかならないこともなさそうです。V(^O^)V
これからじっくりと読んでみます。

＞書き込んだら長いし、読みづらいですね、
サンプルコードは自分で字下げしながら読みますので、大丈夫です。
長いのは...しかたないですよね。

書き込んだら長いし、読みづらいですね、すみません。
サンプルはProcedure EventEnabledObject;からです。

以下のものは11以降で...、PIOはポイント型で「指定されたイベントで実行」をオンに
してお使いください。
前半はネメチェックが作ったPluginLibraryについての説明です。後半はそれのサンプ
ルです。

{
This file contains the constants necessary to implement extended
properties and events for VectorScript objects. Listed below are the
properties that can be assigned to objects that have the "Script Execution
with Script-Specified Events" set. The object script for an event driven
object must first call the drop-in routine VSOGetEventInfo so the appropriate
event handling code can be called.
}


{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\ //\\}
{ //\\ PROPERTY CONSTANTS //\\}
{ //\\ //\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}

{
Extended Properties are set using the drop-in routines SetObjPropVS and
SetObjPropCharVS


kObjXPropEditGroup = 1;
This 8 bit 'Char' property holds one of the property values listed
below in the 'kObjXPropEditGroup Object Property Values' section.


kObjXPropSpecialEdit = 3;
This 'Char' property holds one of the property values listed below in the
'kObjXPropSpecialEdit Object Property Values' section.


kObjXPropPreference = 4;
This 'Boolean property specifies that the object will be called
with its associated event kOnObjPrefEventID. THe object handles
this event by running a custom preferences dialog.


kObjectHasUIOverrideID= 8;
This 'Boolean property specifies that the object will supply widgets
that do not map to parameters. They can provide button widgets as well
as static text using VSOInsertWidget and VSO AppendWidget. Button widgets
also have the associated object event kOnObjectUIButtonHit. The application
calls the object when the user presses the button.
}



{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\ 8 bit "Char' / 'Byte' //\\}
{ //\\ //\\}
{ //\\ PROPERTIY VALUES //\\}
{ //\\ //\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}

{ kObjXPropEditGroup Object Property Values
kObjXPropEditGroupDefault = 0;
kObjXPropEditGroupProfile = 1;
kObjXPropEditGroupPath = 2;
kObjXPropEditGroupCustom = 3;}

{ kObjXPropSpecialEdit Object Property Values
kDefaultSpecialEdit = 0;
kCustomSpecialEdit = 1;
kPropertiesSpecialEdit = 2;
kReshapeSpecialEdit = 3;}


{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\ Object Definition Procedure //\\}
{ //\\ //\\}
{ //\\ EVENT IDs //\\}
{ //\\ //\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{
kResetEventID= 3;
The state of the object has changed and the application
calls the script to regenerate itself. The application has set
the VectorScript environment so all objects creation goes into
the object container with appropriate defaults.


kOnObjPrefEventID= 4;
The object is being inserted in a drawing for the first time
or the preferences button has been pressed in the objects insertion
tool. Objects with the kObjXPropPreference property set use
this event to supply a custom dialog to edit object defaults.


kObjOnInitXProperties= 5;
kOnInitPropertiesEventID= 5; an earlier naming of the above -- needs to be removed
The Application needs to know what extended properties are present
for this object. It calls the script with a kObjOnInitXProperties
so the script can supply these properties.


kObjOnSpecialEditID= 7;
Objects that have specified a kObjXPropSpecialEdit property value
of kCustomSpecialEdit are called by the application when the user
invokes the Special Edit command from the context menu or from a
cursor tool double-click.


kOnObjectUIButtonHit= 35;
Objects that have specified a kObjectHasUIOverrideID property and
have added a button widget are called with this event when the user
presses the specified button. Scripts use the eventData and the
script supplied mappingID to distinguish between multiple buttons.
Buttons should be used to edit object properties NOT to execute a command.
For example, an object should not supply a button that operates on any
property that does not belong to this object instance.
}



{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\ kObjectHasUIOverrideID //\\}
{ //\\ //\\}
{ //\\ Widgets Constants //\\}
{ //\\ //\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{

kFieldLongInt= 1;
kFieldBoolean= 2;
kFieldReal= 3;
kFieldText= 4;
kFieldCalculation= 5;
kFieldHandle = 6;
kFieldCoordDisp= 7; dimension
kFieldPopUp= 8;
kFieldRadio= 9;
kFieldCoordLocX= 10;
kFieldCoordLocY= 11;

kWidgetButton= 12;
kWidgetStaticText= 13;
kWidgetDisclosure= 14; not implemented?}


{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\ //\\}
{ //\\ Extended Object Properties //\\}
{ //\\ //\\}
{ //\\ Drop-in APIs //\\}
{ //\\ //\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}
{ //\\//\\//\\//\\//\\//\\//\\//\\//\\//\\}

{

SetObjPropVS(propertyID: LONGINT;
propertyVal: BOOLEAN)
: BOOLEAN;
SetObjPropVS is called from the kObjOnInitXProperties event handling code to
supply boolean properties.


SetObjPropCharVS(propertyID: LONGINT;
propertyVal: CHAR)
: BOOLEAN;
SetObjPropCharVS is called from the kObjOnInitXProperties event handling code to
supply 8 bit Char/Byte properties.

VSOGetEventInfo(VAR outObjEvent: LONGINT; // the current event
VAR outEventData: LONGINT);// the current event data
Event handling scripts always call VSOGetEventInfo to get the current event.

VSOAppendWidget(widgetType: LONGINT; // kWidgetButton or kStaticText
mappingID: LONGINT; // script supplied ID returned supplied with
text: STRING; // The text of the widget
data: LONGINT) // unused
: BOOLEAN;
Objects that have set the kObjectHasUIOverrideID property call VSOAppendWidget to
add specified widget to the current widget list.

VSOInsertWidget(paramID: LONGINT; // the index of the parameter after this widget
widgetType: LONGINT; // kWidgetButton or kStaticText
mappingID: LONGINT; // object supplied ID returned supplied with
// kOnObjectUIButtonHit
text: STRING; // The text of the widget
data: LONGINT) // unused
: BOOLEAN;
Objects that have set the kObjectHasUIOverrideID property call VSOInsertWidget
to specify a widget in the shape pane and properties dialog. See the Widgets Constants
above for suppoerted widgetType. The Mapping Id is returned in the outEventData
parameter of VSOGetEventInfo during kOnObjectUIButtonHit events.

VSOInsertAllParams() : BOOLEAN;
Objects that have set the kObjectHasUIOverrideID property call VSOInsertAllParams
to insert all the parameter widgets defined FOR the OBJECT.}

Procedure EventEnabledObject;
Const
kOnInitPropertiesEventID = 5 ;
kOnObjPrefEventID= 4 ;
kWidgetButton = 12 ;
kObjectHasUIOverrideID = 8 ;
kResetEventID = 3 ;
kOnObjectUIButtonHit = 35 ;
Var
theEvent, theButton : Longint ;
objHand, recHand, wallHand : Handle ;
objName, saveClass, noneClass : String ;
fillPattern :integer;
cnt : Integer ;
int : Integer ;
boo : Boolean ;
str : String ;


Procedure dialog1_Main( Var fillPattern : Integer ) ;
Var
dialog1 : Integer ;
imagePopup4Int : Integer ;

Procedure LoadPatterns( dialogID , controlID : Longint ) ;
Var
garbInt : Integer ;
Begin
If GetObject('System: Pattern Previews') = nil Then Begin
NameObject('System: Pattern Previews');
BeginFolder;
EndFolder;
End ;
If GetObject('Pattern-00') = nil Then Begin
BeginSym(Concat('Pattern-00', str));
Rect(0, 0, 10, 10); SetFPat(LNewObj, 0); SetLW(LNewObj, 1); SetPenFore(LNewObj, 0, 0, 0);
MoveTo(0, 0); LineTo(10, 10); SetLW(LNewObj, 1); SetPenFore(LNewObj, 0, 0, 0);
MoveTo(10, 0); LineTo(0, 10); SetLW(LNewObj, 1); SetPenFore(LNewObj, 0, 0, 0);
EndSym;
InsertSymbolInFolder(GetObject('System: Pattern Previews'), GetObject('Pattern-00'));
For cnt := 1 to 71 Do Begin
str := Num2Str(0, cnt);
If Len(str) = 1 Then str := Concat('0', str);
BeginSym(Concat('Pattern-', str));
Rect(0, 0, 10, 10);
SetFPat(LNewObj, cnt);
SetLW(LNewObj, 1);
SetPenFore(LNewObj, 0, 0, 0);
EndSym;
InsertSymbolInFolder(GetObject('System: Pattern Previews'), GetObject(Concat('Pattern-', str)));
End ;
End ;
RemoveAllImagePopupItems(dialogID, controlID);
For cnt := 0 to 71 Do Begin
str := Num2Str(0, cnt);
If Len(str) = 1 Then str := Concat('0', str);
garbInt := InsertImagePopupObjectItem(dialogID, controlID, Concat('Pattern-', str));
End ;
SetImagePopupSelectedItem(dialogID, controlID, 1);
End ;


Procedure dialog1_Handler( Var item : Longint ; data : Longint ) ;
Begin
Case item of
SetupDialogC :
Begin
LoadPatterns(dialog1, 4);
SetImagePopupSelectedItem(dialog1, 4, fillPattern + 1);
End ;
1: Begin
imagePopup4Int := GetImagePopupSelectedItem(dialog1, 4);
End ;
End ;
End ;

Begin
dialog1 := CreateLayout('Select A Pattern', FALSE, 'OK', '');
CreateControl(dialog1, 4, 10, '', 0);
SetFirstLayoutItem(dialog1, 4);
If RunLayoutDialog(dialog1, dialog1_Handler) = 1 Then fillPattern := imagePopup4Int - 1;
End ;


Procedure ResetEventHandler;
Begin
Rect(0, 0, 1, 1);
SetFPat(LNewObj, pPattern_Number);
End ;

{=================Main===================}
Begin
vsoGetEventInfo(theEvent, theButton);
Message( 'theEvent= ' , theEvent , ' theButton= ' , theButton ) ;
Case theEvent of
kOnInitPropertiesEventID:
Begin
boo := SetObjPropVS(kObjectHasUIOverrideID, TRUE);
boo := vsoInsertAllParams;
boo := vsoAppendWidget(kWidgetButton, 1, 'Select Pattern...', 1);
boo := vsoAppendWidget(kWidgetButton, 2, 'Add...', 1);
End ;
kOnObjectUIButtonHit:
Begin
Case theButton of
1 : Begin
boo := GetCustomObjectInfo(objName, objHand, recHand, wallHand);
fillPattern := Str2Num(GetRField(objHand, objName, 'Pattern Number'));
dialog1_Main(fillPattern);
SetRField(objHand, objName, 'Pattern Number', Num2Str(0, fillPattern));
ResetObject(objHand);
End ;
2 :Begin
End ;
End ;
End ;
kResetEventID:
Begin
ResetEventHandler;
End ;
End ;
End ;
Run(EventEnabledObject);

下のprocedureでグループ図形を触ると、グループ内の図形の面の色が変わってしまいます。
このままでは危なくて使えません。
グループの属性を変えると、その中の全ての図形の属性も変わってしまうのですね。
いままで、グループ内の個々の図形にアクセスしないといけないと思ってました。

メニューで線種を選択して、線種番号を返すprocedureです。
メニュー外の図形でも選択できてしまいますが、ハンドルをチェックして、
選択しないように修正可能です。

procedure Test_LineStyle;
var
＿lnStyle＿:integer;
＿
procedure GetLineStyle(var lS:integer);
{ メニューで線種を選択して、線種番号を返します。 }
{ 注意：環境設定の「VectorScriptの警告を表示」を強制的にOFFにしています。 }
const
＿LineLength = 150;
＿Pitch = 16;
＿FlipCol = 18;
var
＿hL, hR＿:array[-32..2] of handle;
＿h, h0＿:handle;
＿i＿:integer;
＿xc, yc, zoom＿:real;
＿x0, y0, lnLen＿:real;
＿showLnWt＿:boolean;{ 拡大時に線の太さを表示 }
＿x, y, k＿:real;
＿minLnStyle＿:integer;{ 線種番号の下限 }
＿lnStyle＿:integer;{ デフォルトの線種 }
＿r, g, b＿:real;
＿ff, fb＿:integer;
＿
＿function Set_k:real;{ 描画倍率を計算します。 }
＿var
＿＿scale, upi＿:real;
＿＿fraction, display＿:longint;
＿＿format＿:integer;
＿＿name, squareName＿:string;
＿begin
＿＿scale:= GetLScale(ActLayer);
＿＿GetUnits(fraction, display, format, upi, name, squareName);
＿＿Set_k:= upi * scale / 25.4 / 72 * 25.4;
＿end;{Set_k}

begin{GetLineStyle}
＿SetPref(21, false);
＿lnStyle:= FPenPat;
＿i:= 0;
＿repeat{ 線種の数（線種番号の下限）を調査します。 }
＿＿i:= i - 1;
＿＿PenPat(i);
＿until FndError;
＿minLnStyle:= i + 1;
＿showLnWt:= GetPref(9);
＿SetPref(9, false);
＿GetVCenter(xc, yc);
＿zoom:= GetZoom;
＿SetZoom(100);
＿k:= Set_k;
＿lnLen:= k * LineLength;
＿x0:= xc - lnLen/2;
＿y0:= yc - k*minLnStyle*Pitch/2;
＿y:= y0;
＿for i:= 2 downto minLnStyle do begin{ メニュー項目描画ループ }
＿＿if (i = 2) | (i < 0)then begin
＿＿＿PenPat(i);
＿＿＿Rect(x0-k*Pitch, y+k*Pitch/2, x0+lnLen+k*Pitch, y-k*Pitch/2);
＿＿＿hR[i]:= LNewObj;
＿＿＿SetDSelect(hR[i]);
＿＿＿SetFPat(hR[i], 2);
＿＿＿SetLW(hR[i], 0);
＿＿＿SetFillFore(hR[i], 0);
＿＿＿MoveTo(x0, y); LineTo(x0 + lnLen, y);
＿＿＿hL[i]:= LNewObj;
＿＿＿SetDSelect(hL[i]);
＿＿＿y:= y - k*Pitch;
＿＿end;{if}
＿end;{for}
＿PenPat(2);
＿Rect(x0-k*Pitch, y0+k*Pitch/2, x0+lnLen+k*Pitch, y0-k*Pitch*(1/2-minLnStyle));{ メニュー枠 }
＿hL[0]:= LNewObj;
＿SetFPat(hL[0], 0);
＿SetFillFore(hL[0], 0);
＿SetDSelect(hL[0]);
＿ReDrawAll;
＿h0:= nil;
＿ff:= 0;
＿fb:= 0;
＿while not MouseDown(x, y) do begin{ メニュー項目選択ループ }
＿＿GetMouse(x, y);
＿＿h:= PickObject(x, y);
＿＿for i:= 2 downto minLnStyle do
＿＿＿if (h <> nil) & (h = hL[i]) then
＿＿＿＿h:= hR[i];
＿＿if h <> h0 then begin
＿＿＿if h0 <> nil then begin
＿＿＿＿SetFillFore(h0, ff);
＿＿＿＿SetFillBack(h0, fb);
＿＿＿end;{if}
＿＿＿GetFillFore(h, r, g, b);
＿＿＿RGBToColorIndex(r, g, b, ff);
＿＿＿GetFillBack(h, r, g, b);
＿＿＿RGBToColorIndex(r, g, b, fb);
＿＿＿SetFillFore(h, FlipCol);
＿＿＿SetFillBack(h, FlipCol);
＿＿＿h0:= h;
＿＿＿ReDrawAll;
＿＿end;{if}
＿end;{while}
＿SetFillFore(h0, ff);
＿SetFillBack(h0, fb);
＿if h = nil then begin
＿＿lS:= 2;
＿end{if}
＿else begin
＿＿lS:= GetLS(h);
＿end;{else}
＿for i:= -32 to 2 do begin{ メニュー項目削除ループ }
＿＿if hL[i] <> nil then
＿＿＿DelObject(hL[i]);
＿＿if hR[i] <> nil then
＿＿＿DelObject(hR[i]);
＿end;{for}
＿SetZoom(zoom);
＿SetPref(9, showLnWt);
＿PenPat(lnStyle);
＿ReDraw;
end;{GetLineStyle}

begin{main}
＿GetLineStyle(lnStyle);
＿Message('LineStyle= ', lnStyle);
end;
Run(Test_LineStyle);

石男さん、要望します、お願いします、披露してくださいませ。m(_._)m
（急ぎませんので、HiBaseが終わってからでかまいませんよ。）

VS Language Guide(11) の第10章の Setting Script Execution Options の、
With Script-Specified Events 項目が関係ありとみましたが、間違ってますか？
そこから先へは進めませんでしたが。

＞ちょっと変えれば色番号や線種を選択するサブルーチンも出来そうです。
ちょっと変えれば模様番号や線種を選択するサブルーチンも出来そうです。
の間違いでした。

白黒表示やカラーレイヤ表示のときは色が判りませんが、一時的にカラー表示に変更すれば、
大丈夫でしょう。
あと、線種を表示するときは、「拡大時に線の太さを表示」させないとか。

与太郎さん
厳密に言えば10.5からいけるはずなんですが、どうも駄目でした。で私的に確認したの
は11ということで...。
そう！バリバリの英語です。要望があればここに出しますが...。

とりあえず使う予定はないんですが、色を選択するprocedureを作ってみました。
procedure GetColIndex がそれです。
ちょっと変えれば色番号や線種を選択するサブルーチンも出来そうです。

procedure Test_ColorPalett;
var
＿col＿:integer;

procedure GetColIndex(var iCol:integer);
{ カラーパレットを表示して、色番号を返します。 }
{ キャンセル（範囲外）なら-1を返します。 }
const
＿BlockSize = 18;
var
＿zoom, xc, yc＿:real;
＿k, kB, kS＿:real;
＿x, y, x0, y0＿:real;
＿i, j＿:integer;
＿h ＿:handle;
＿hB＿:array[0..15, 0..15] of handle;
＿r, g, b＿:real;
＿
＿function Set_k:real;{ 描画倍率を計算します。 }
＿var
＿＿scale, upi＿:real;
＿＿fraction, display＿:longint;
＿＿format＿:integer;
＿＿name, squareName＿:string;
＿＿result＿:real;
＿begin
＿＿scale:= GetLScale(ActLayer);
＿＿GetUnits(fraction, display, format, upi, name, squareName);
＿＿Set_k:= upi * scale / 25.4 / 72 * 25.4;
＿end;{Set_k}
＿
＿function LocToColIndex(iX, iY:integer):integer;
＿var
＿＿result＿:integer;
＿＿i＿:integer;
＿begin
＿＿i:= 16 * iY + iX;
＿＿case i of
＿＿＿1: result:= 255;
＿＿＿17: result:= 254;
＿＿＿22: result:= 247;
＿＿＿23: result:= 252;
＿＿＿25: result:= 253;
＿＿＿29: result:= 249;
＿＿＿34: result:= 251;
＿＿＿37: result:= 246;
＿＿＿43: result:= 250;
＿＿＿45: result:= 245;
＿＿＿47: result:= 248;
＿＿＿245: result:= 45;
＿＿＿246: result:= 37;
＿＿＿247: result:= 22;
＿＿＿248: result:= 47;
＿＿＿249: result:= 29;
＿＿＿250: result:= 43;
＿＿＿251: result:= 34;
＿＿＿252: result:= 23;
＿＿＿253: result:= 25;
＿＿＿254: result:= 17;
＿＿＿255: result:= 1;
＿＿＿otherwise result:= i;
＿＿end;{case}
＿＿LocToColIndex:= result;
＿end;{LocToColIndex}
＿
begin{GetColIndex}
＿k:= Set_k;
＿GetVCenter(xc, yc);
＿zoom:= GetZoom;
＿kB:= k * BlockSize * 100 / zoom;
＿kS:= kB / 6;
＿x0:= xc - 8 * kB;
＿y0:= yc + 8 * kB;
＿for j:= 0 to 15 do begin
＿＿for i:= 0 to 15 do begin
＿＿＿Rect(x0+i*kB+kS, y0-j*kB-kS, x0+(i+1)*kB-kS, y0-(j+1)*kB+kS);
＿＿＿hB[i, j]:= LNewObj;
＿＿＿SetDSelect(hB[i, j]);
＿＿＿SetFPat(hB[i, j], 2);
＿＿＿SetFillFore(hB[i, j], LocToColIndex(i, j));
＿＿end;{for}
＿end;{for}
＿ReDraw;
＿i:= -1; j:= -1;
＿GetPt(x, y);
＿h:=PickObject(x, y);
＿if h = nil then begin
＿＿iCol:= -1;
＿end{if}
＿else begin
＿＿GetFillFore(h, r, g, b);
＿＿RGBToColorIndex(r, g, b, iCol);
＿end;{else}
＿for j:= 0 to 15 do
＿＿for i:= 0 to 15 do
＿＿＿DelObject(hB[i, j]);
end;{GetColIndex}

begin{main}
＿GetColIndex(col);
＿Message(col);
end;
Run(Test_ColorPalett);

＞石男さん
英語ですか〜、VW11ですか〜（泣き）。

やっぱりバージョンアップするべきか。
バグが出尽くすまで待ってみようかと思ってましたが、
これって、早めにバージョンアップor新規購入した人にテストしていただいているということですよね。

＞ポイント型のPIOにプッシュボタンを付ける
　ネメチェックのVSマニュアルを読むとPIOにイベントが付けられます。実際には11か
らの機能ですが、これを使ってPIOのデータパレットにプッシュボタンが付けられす。
普通、PIOにはダイアログが付けられませんが、プッシュボタンに仕込むことが出来ま
す。後はSetRFieldを使ってダイアログからの贈り物をセットしていくだけです。
　でも、サンプルはネメチェックのVS_MLの過去のログに埋没しています。当然ながら
全て英文で書かれています。

石男さん、
＞与太郎さんのつっこみにはたじたじです...。
ほっとくと段々増長してきますが、注意していただけたら静かになると思います。

＞ポイント型のPIOにプッシュボタンを付ける
イメージできませんでした。
オブジェクトにボタンが付いてるのですか？
ボタンを押したらイベントを送れるのですか？
どうやってイベントを受け取るのですか？
勉強会が終わって暇が出来たら、教えてくださいな。
って、ぜんぜん静かになってませんねえ。

最近、Contorol Pointというもパラメータのを発見（見逃してただけ）したので、1点、2点、3点型
のPIOでも制御点を増やせることがわかって喜んでおります。2Dパスでやると、変形時に余計な線が
表示されて見苦しいし、文字を自分で回転させないといけないので、ちょっと悩んでおりました。
Contorol Pointはデータパレットで表示されなくても困らないので、パラメータの下のほうにして
おけばデータパレットの表示領域を圧迫しないのもいいですね。

PIOのパラメータをプラグインの中で書き換える必要があって、バックナンバーを読んでみましたが、
ソースがなかったので，わかりにくかったです。レコードハンドルと図形ハンドルを混同して、一時
間ほど原因を探してしまいました。
ポップアップ型のパラメータで、リストにないサイズをダイアログで入力するルーチンです。
「直接入力...」の項目を選択すると、ダイアログが出るというものです。値が「直接入力...」のま
まだとオブジェクトを変更するたびにダイアログが出るので、書き換える必要がありました。

与太郎さんのつっこみにはたじたじです...。

HiBaseに関しては、マニュアルにある通りの使い方しかわかりません。したがって、現
状では使いにくいものかもしれません...。それでも、発表されてから石男はずーっと
使い続けています。もっと反応があれば善処してくれるはずです...。

その代わりと言ってはなんですが、モダンダイアログ（カスタム）で条件に応じて
アイテムを作りだす技？やポイント型のPIOにプッシュボタンを付けることなどなら、ご希望にお答えできると思います...。

D-Dayまで10日ですね。
外部データベースの使い道、わかりません。（そういう仕事もないし）
でも、興味があるので、（東京クラブの勉強会だけど、）ここで発表していただけたらいいなあ。
あるいは、「From A&A」とかでね。

標準Pascalの IN [ ] ていうのは [ ]内は整数型だから、(R IN ['レコード'])のように文字列型が許される
のは変なんですが、内部的にはレコードのインデックス番号みたいなので処理してるのかなと思ってました。
でも違ってました。
実際は、スクリプトを実行するときに検索条件の ( )内の式をインタープリタで処理してるのですね。
よく考えれば、実行してみないとレコードの番号は特定できませんから、当然です。
VW8でインタープリタ方式から（Javaみたいに中間コードを生成する）コンパイラ方式に変更になったけど、
検索条件を評価する部分はインタープリタのままということのようです。
そのこと自体は悪くないんだけど、(R IN [ ])というのが、Pascalの集合型と同じ表現だし、
レイヤーの場合は(L=layerName)と、変数でも指定できるので、勘違いしてしまいました。

ところで、レコード名に「'」が含まれてると、スクリプトで厄介なことになりそうです。

＞ところで、もしかして、これってHiBaseに関係あります？
かなり、関係があります...。

恐縮です。書き直しですか〜。
思い出すのに半日も掛かかるなんて、カセットテープから（300ボーくらいで）データを読んでるような遅さでした。
ところで、もしかして、これってHiBaseに関係あります？

いや、本当に済みません、与太郎さん。
今、総当たりのScriptを書き終わったところでした...。
もう一度、参考にして書き直します...、与太郎さん。

検索条件を文字列にすれば良かったのを思い出しました。

procedure test1;
const
Rec1 = 'Record-1';
Rec2 = 'Record-2';
SQ = Chr(39);
var
criteria:string;
begin
criteria:= Concat('(R IN [', SQ, Rec1, SQ, ', ', SQ, Rec2, SQ, '])');
Message(Count(criteria), ' : ', criteria);
end;
Run(test1);

procedure test2;
const
Rec1 = '''Record-1''';
Rec2 = '''Record-2''';
var
criteria:string;
begin
criteria:= Concat('(R IN [', Rec1, ', ',Rec2, '])');
Message(Count(criteria), ' : ', criteria);
end;
Run(test2);

どちらも同じ結果になります。

＞図形タイプに47、48とにレコードが定義されているのが不思議です...。
Type47---レコード定義。シンボルフォルダにリンクされてます。
たぶん、シンボル定義と同じ方法でハンドルを取ります。
Type48---レコード。図形にリンクされてます。GetRecord(objHandle, index)でハンドルを取ります。

いつも、どうもすみません、与太郎さん。
やはり、検索条件に直接レコード名をいれないといけないんですね。
別な手でNameListからやってみましたが、やはりレコードのハンドルは返ってきません
でした...。当然と言えば当然でしたが、そうなるとベタな総当たりで順を追ってやる
方法しかないようですね...。しかし、図形タイプに47、48とにレコードが定義されて
いるのが不思議です...。

[ ]内に直接レコード名を入れないとダメみたいです。

procedure test1;
const
Rec1 = 'Record-1';
Rec2 = 'Record-2';
begin
Message(Count((R IN [Rec1, Rec2])));
end;
Run(test1);

procedure test2;
var
rec1, rec2:string;
begin
rec1:= 'Record-1';
rec2:= 'Record-2';
Message(Count((R IN [rec1, rec2])));
end;
Run(test2);

残念ながら、test1、test2共にコンパイルされますが、カウントされませんでした。
(VW10/Winデモ版にて)

石男さん、
レコードの種類が多いとたいへんですが、
i:= Count(R IN ['Record-1','Record-2']);
でカウント出来ます。
'Record-1'か'Record-2'のどちらかでも付いてればカウントされます。

レコード付き図形の数をカウントしようと思って...
i := Count( T = 47 ) ;もしくは T = 48でやってみたところ
「0」しか返ってきません。当然、レコード付き図形はばらまいています。
やはり、図形のハンドルを取ってからレコードの有無を確認するしかないのでしょうか

与太郎さんご親切にありがとうございます。
>うっかり「コマンド+Ｄ」を押したり、複製したのに移動するのを忘れたり、３Ｄ図形を２Ｄ化して、
>図形が重なってしまうのはよくあることです。ワークシートで集計したりするときには、致命的です。
>「不要情報を除去...」に、「重複図形を削除」のオプションがあると助かるのですがね。
同感です。これがあることでどれだけ仕事が短縮されることか。心置きなくワークシートを使える環境が
整うことを願っています。
>Script談話室のバックナンバーに「重複図形を削除」について、一連のやりとりがあります。
拝見しましたが難しすぎてチンプンカンプンです。やはりスクリプトのハードルは高いですね。
（重複グループ図形を削除するスクリプト）で少しずつ勉強してみます。

＞シンボルを並べて配列のパターンをグループ化していたので
普通、グループでなくてシンボルを並べますよね（でないと修正がたいへん）。一応、シンボル版も作ってみまし
たが、グループ版だけ書き込みました。GROUP→SYMBOL の変更は直感でわかりましたか？

＞数百個単位の図形なら同じ図形の重複は下のスクリプトのタイプの部分を変えることでほぼ対応出来る
＞のでしょうか？
下のスクリプトは図形のBoundRectを比較しているだけなので、限定された条件でしか正しく動きません。（基本
的に図形が重なることはない、属性を無視できること）
厳密には、直線なら端点同士、多角形なら頂点全部を比較するなど、図形タイプによって、処理の仕方を変えない
といけません。２Ｄ図形だと、下のようになります。

基準点----Ｘ，Ｙ座標
直線------端点の座標
四角形----BoundRect
多角形----とりあえずBoundRect、そのあと各頂点座標、開／閉
曲線------とりあえずBoundRect、そのあと各頂点座標／タイプ、開／閉、各辺の表示／非表示
円弧------中心座標、半径、開始角、円弧角
円--------中心座標、半径
シンボル--シンボル名、挿入点座標、回転角
グループ--とりあえずBoundRect、そのあと中の図形ごとに比較
文字------基点の座標、角度、反転、文字、フォント，サイズ，スタイル
寸法------基準点座標、オフセット、その他

全ての図形---属性（クラス、線／面の色、パターン、線種、マーカー）、ロック状態

また、図形に名前、レコードが設定されていれば、それも考慮しないといけません。（名前が付いていたら削除し
ないとか、レコードの内容が同じなら削除するとか）

きちんとやると（量的に）たいへんです。

＞タイプによってデータが壊れるようなことはないのですか。
きちんと比較しないと、実際には重複していない図形を削除してしまう恐れがあります。

うっかり「コマンド+Ｄ」を押したり、複製したのに移動するのを忘れたり、３Ｄ図形を２Ｄ化して、図形が重なっ
てしまうのはよくあることです。ワークシートで集計したりするときには、致命的です。「不要情報を除去...」に、
「重複図形を削除」のオプションがあると助かるのですがね。

Script談話室のバックナンバーに「重複図形を削除」について、一連のやりとりがあります。

与太郎さんありがとうございます。
説明不足でした。シンボルを並べて配列のパターンをグループ化していたので全て並べた後グループ
を解除することでグループの重複ではなくシンボルが重複していました。
そこで下のスクリプトの(T=GROUP)の部分を(T=SYMBOL)してみたらうまく消えてくれました。

数百個単位の図形なら同じ図形の重複は下のスクリプトのタイプの部分を変えることでほぼ対応出来る
のでしょうか？タイプによってデータが壊れるようなことはないのですか。スクリプトは全然わからず
メニューツールの選択/表示マクロ位しか使っていないのでよくわかりません。
VectorWorks 談話室より
>>3つ重なった図形の見つけ方教えてください 　nao　　Sat Sep 11 13:37:14 2004
>>レイアウトで300個ほどの図形を配置する仕事がありました。縦横が揃っているわけではなく
>>模様のように並べるとのことでした。パターンを造りグループ化して並べていきました。2つ重なった
>>図形は選択すればわかるのですが3つ重なった図形は1度見逃すと探し出せません。当然造るのに並べた
>>場合の正確な個数が知りたいとのことでしたので結局図面から何回も数え、計算で出したものと比較し
>>て出しました。重なりが怖くてワークシートのCOUNTは使えませんでした。
>>作図後重なった図形を見つける方法がありましたら教えてください。

アクティブレイヤの重複グループ図形を削除します。外枠の大きさだけ比較しています。
グループの中身はは調べていません。
数百個の図形なら全部比較しても時間はかからないので、図形ハンドルのソートもやってません。
何千個にもなると、このスクリプトでは時間がかかり過ぎるでしょう。

procedure Del_OverlapGroup;{ 重複グループを削除する }
{$ DEBUG}
var
actLName:string;
x11, y11, x12, y12:real;
x21, y21, x22, y22:real;
h1, h2, hD:handle;
i, n, num:integer;
begin
actLName:= GetLName(ActLayer);
DSelectAll;
num:= Count((L=actLName)&(T=GROUP));
SelectObj((L=actLName)&(T=GROUP));
n:= 0;
i:= 0;
h1:= FSActLayer;
while h1 <> nil do begin
i:= i + 1;
Message(Concat(Num2Str(0, n), ' : ', Num2Str(0, i), ' / ', Num2Str(0, num)));
h2:= NextSObj(h1);
while h2 <> nil do begin
GetBBox(h1, x11, y11, x12, y12);
GetBBox(h2, x21, y21, x22, y22);
if EqualRect(x11, y11, x12, y12, x21, y21, x22, y22) then begin
hD:= h2;
h2:= NextSObj(h2);
DelObject(hD);
n:= n + 1;
i:= i + 1;
Message(Concat(Num2Str(0, n), ' : ', Num2Str(0, i), ' / ',

Num2Str(0, num)));
end{if}
else begin
h2:= NextSObj(h2);
end;{else}
end;{while}
h1:= NextSObj(h1);
end;{while}
DSelectAll;
ClrMessage;
if n > 0 then begin
AlrtDialog(Concat(Num2Str(0, n), '個のグループを削除しました。'));
end;{if}
end;
Run(Del_OverlapGroup);

ワークシートの選択範囲のセルの文字を、クリック−ドラッグで描きます。クリックで終了します。
フォント、サイズ等は実行前に設定しておきます。
VW9以降対応です。

procedure DrawTextFromWS;{ ＷＳの文字を、クリック−ドラッグで描きます }
{ $ DEBUG }
var
＿hWS, hTx＿:handle;
＿row, maxRow,
＿clm, maxClm,
＿top, left,
＿topSub, bottom, right, botSub＿:integer;
＿x1, y1, x2, y2＿:real;
＿str＿:string;
＿vec＿:vector;
＿ang＿:real;
begin
＿hWS:= ActSSheet;
＿if hWS = nil then begin
＿＿AlrtDialog('ワークシートを開いてください。');
＿end{if}
＿else begin
＿＿DSelectAll;
＿＿GetWSRowColumnCount(hWS, maxRow, MaxClm);
＿＿GetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿Message('文字を描く位置でクリック−ドラッグしてください。　クリックで終了します。');
＿＿hTx:= nil;
＿＿GetLine(x1, y1, x2, y2);
＿＿＿if (top = bottom) & (left = right) then begin
＿＿＿＿top:= 1; Left:= 1; bottom:= maxRow; right:= maxClm;
＿＿＿＿SetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿＿end;
＿＿while not EqualPt(x1, y1, x2, y2) do begin
＿＿＿GetWSCellFormula(hWS, row, clm, str);
＿＿＿clm:= clm + 1;
＿＿＿if clm > right then begin
＿＿＿＿clm:= left;
＿＿＿＿row:= row + 1;
＿＿＿＿if row >bottom then begin
＿＿＿＿＿row:= top;
＿＿＿＿end;{if}
＿＿＿end;{if}
＿＿＿SetWSSelection(hWS, row, clm, top, left, topSub, bottom, right, botSub);
＿＿＿vec.x:= x2 - x1;
＿＿＿vec.y:= y2 - y1;
＿＿＿ang:= Vec2Ang(vec);
＿＿＿TextOrigin(x1, y1);
＿＿＿TextRotate(ang);
＿＿＿CreateText(str);
＿＿＿DSelectObj(hTx);
＿＿＿hTx:= LNewObj;
＿＿＿SetSelect(hTx);
＿＿＿ReDraw;
＿＿＿GetLine(x1, y1, x2, y2);
＿＿end;{while}
＿＿ClrMessage;
＿end;{else}
end;
Run(DrawTextFromWS);

ちゃんと動くのですが、下のような警告メッセージが出てしまいます。
Warning: DRAWTEXTFROMWS BOTSUB - Attempt to access a cell outside the worksheet bounds.
GetWSSelection()でエラーが出てるようですが、意味がわかりません。
どうしたら警告が出ないように直せるでしょうか？

はじめまして、私は今、卒業研究で「Vector Worksで住宅の３Dを作って、Vector
Scriptでデータを取り出す。」という作業をやっています。しかし、初めてVector
Scriptを使うため、よく分かりません。
Vector Worksのなかの壁ツールをつかって、壁をかき、フラッシュ戸という建築ツールを壁にせんにゅうしました。それをVector Scriptでとりだすと、
｛Object Creation Code｝

NameClass('一般');
SetZVals(0,2400);
DoubLines(200);
ClearCavities;
PenSize(2);
PenPat(2);
FillPat(1);
PenFore(56797,0,0);
PenBack(65535,65535,65535);
Wall(-8888,11111,-8888,7019.37500119);
WallCap(FALSE,FALSE,FALSE,0,0);
AddSystemToWallEdge(LNewObj,1695.812499,0,FALSE,FALSE,'フラッシュ戸',0);
WallCap(TRUE,FALSE,FALSE,100,-100);
SetZVals(0,0);

{End of Creation Code}
というのがでてきて、この部分がオブジェクトのデータだと思うんですが、
WallCapとAddSymToWallEdgeの部分の数値とTRUE,FALSEが何を表しているのか分か
りません。
どなたか教えていただけませんか？？

与太郎さん
わざわざの解説ありがとうございます。なるほど、合点がいきました。
しかも、WS_to_GroupObj改訂版まで...、感謝にたえません。

石男さん、

＞以前、与太郎さんが提供してくれたWSをグループ図形に変換するおまじないについて
＞質問なのですが、サブルーチンのDrawGridとDrawHBorders、DrawVBordersは何か
＞違いがあるのですか？

DrawGrid--------グリッド（セルの境界全部）に線を引きます。
DrawHBorders----横方向の枠線を引きます。
DrawVBorders----縦方向の枠線を引きます。
（グリッドは、ＷＳメニューの「レイアウト設定...」で表示／非表示を設定します。）
（枠線は、ＷＳメニューの「枠線...」で設定します）

ついでに、データベースの従属行を表示出来るように修正したのも出しときます。
２種類の行番号（従属行を含むのと、含まないの）が出てくるので、判りにくくなっちゃいました。

procedure WS_to_GroupObj;
{ Version 0.99 }
{ ワークシートをグループ図形にします（var9以降に対応）}
{ by 与太郎 2004/04/03〜2004/04/03 }
{ 2004/04/12 ワークシート図形を選択しても実行するように修正}
{ 〃　ワークシート図形を選択したときは同位置にグループ図形を作成、ワークシート図形を削除する }
{ 〃　列幅がゼロのときは文字を表示しないように修正 }
{ 〃　グリッドの色をシアンに変更 }
{ 2004/08/26 データベースのサブ行も表示するように修正 }
{ 〃　非表示グリッドのクラスを定義 }

{ 図形化したいワークシートを表示、またはワークシート図形を選択して、実行する }
{ 属性はクラス属性で変更可能 }
{ クラス名、クラス属性、セルの余白は好みで書き換えてください。 }
{$ DEBUG}
const
{ クラス名とクラス属性 }
＿ClsWSText = 'WS-Text';
＿ClsWSGrid = 'WS-Grid';
＿ClsWSGridHd = 'WS-Grid_Hide';{ ----2004/8/26 追加 }
＿ClsWSOutLine = 'WS-Outline';
＿ClsWSBorder = 'WS-Border';
＿OutlineWidth = 21;{ 0.53ミリ }
＿OutlineColor = 15;{ 赤色 }
＿GridWidth = 1;{ 0.025ミリ }
＿GridColor = 2;{ シアン }
＿GridHdWidth = 1;{ 0.025ミリ }{ ----2004/8/26 追加 }
＿GridHdColor = 5;{ 黄色 }{ ----2004/8/26 追加 }
＿LnWidth = 11;{ 0.28ミリ }
＿LnColor = 4;{ 青色 }
＿txtColor = 15;{ 赤色 }
＿
{ セルの余白 }
＿LeftMargin = 3;{ 3ポイント=1.06ミリ }
＿RightMargin = 3;{ 3ポイント=1.06ミリ }

{ オブジェクト識別番号 }
＿ShowGrid = 83;{ ＷＳのグリッド表示 }{ ----2004/8/26 追加 }
＿
type
＿wsCell = structure
＿＿subAlign, { ----2004/8/26 追加 }
＿＿align＿:integer;{ 0=標準／1=左よせ／2=センタ／3=右よせ }
＿＿txt＿:string;{ セルの内容 }
＿＿fontID＿:integer;
＿＿size＿:integer;
＿＿Style＿:integer;{Plain:0／Bold:1／Italic:2／Underline:4／Outline:8／Shadow:16}
＿end;{structure}
＿
var
＿k＿:real;＿{ 描画倍率 }
＿hWS＿:handle;＿{ ＷＳのハンドル }
＿hTbl＿:handle;＿{ ＷＳ図形のハンドル }
＿maxRow, maxClm＿:integer;＿{ ＷＳの行数，列数 }
＿maxRowDB＿:integer;＿{ サブ行を含んだ行数 }{ ----2004/8/24 追加 }
＿indexRDB＿:dynArray[] of integer;＿{ 行番号→サブ行を含んだ行番号 }{ ----2004/8/24 追加 }
＿wd＿:dynArray[] of integer;＿{ セル幅 }
＿ht＿:dynArray[] of integer;＿{ セル高さ }
＿subRows＿:dynArray[] of integer;＿{ サブ行の数 }{ ----2004/8/24 追加 }
＿x＿:dynArray[] of real;＿{ セル境界のＸ座標 }
＿y＿:dynArray[] of real;＿{ セル境界のＹ座標 }
＿hLine＿:dynArray[,] of boolean;＿{ 横罫線の有無 }
＿vLine＿:dynArray[,] of boolean;＿{ 縦罫線の有無 }

procedure Set_k;{ 描画倍率を計算します。 }
var
＿scale＿:real;
＿upi＿:real;
＿fraction, display＿:longint;
＿format＿:integer;
＿name, squareName＿:string;
begin
＿scale:= GetLScale(ActLayer);
＿GetUnits(fraction, display, format, upi, name, squareName);
＿k:= upi * scale / 25.4 / 72 * 25.4;
end;{Set_k}

procedure GetWSHandle(var hWS, hTbl:handle);
{ ワークシートとワークシート図形のハンドルを返します。 }
begin
＿hWS:= ActSSheet;
＿if hWS = nil then begin
＿＿hTbl:= FSActLayer;
＿＿if (hTbl <> nil) & (GetType(hTbl) = 56) then begin
＿＿＿hWS:= GetWSFromImage(hTbl);
＿＿end;{if}
＿end;{if}
end;{GetWSHandle}

function Row2RowDB(row, subRow:integer):integer;
begin
＿Row2RowDB:= indexRDB[row] + subRow;
end;{Row2RowDB}

procedure Init_Vars;{ 変数を初期化します。 }
var
＿row, rowDB, clm＿:integer;{ ----2004/8/24 rowDBを追加 }
＿top, left, bottom, right＿:boolean;
＿
＿procedure Set_or(var source:boolean; dist:boolean);
＿begin
＿＿source:= source or dist;
＿end;{Set_or}
＿
＿begin{Init_Vars}
＿＿{ 配列を確保 }
＿＿GetWSRowColumnCount(hWS, maxRow, maxClm);
＿＿Allocate indexRDB[0..maxRow];{ ----2004/8/24 追加 }
＿＿Allocate subRows[0..maxRow];{ ----2004/8/24 追加 }
＿＿
＿{ ↓2004/8/24 追加 }
＿＿for row:= 1 to maxRow do
＿＿＿subRows[row]:= 0;
＿＿indexRDB[0]:= 0;
＿＿subRows[0]:= 0;
＿＿for row:= 1 to maxRow do begin
＿＿＿if IsWSDatabaseRow(hWS, row) then
＿＿＿＿GetWSSubrowCount(hWS, row, subRows[row]);
＿＿＿indexRDB[row]:= indexRDB[row-1] + subRows[row-1] + 1;
＿＿end;{for}
＿＿maxRowDB:= indexRDB[maxRow] + subRows[maxRow];
＿{ ↑2004/8/24 追加 }
＿＿
＿＿Allocate ht[1..maxRowDB];
＿＿Allocate wd[1..maxClm];
＿＿Allocate x[0..maxClm];
＿＿Allocate y[0..maxRowDB];
＿＿Allocate hLine[0..maxRowDB, 0..maxClm];
＿＿Allocate vLine[0..maxRowDB, 0..maxClm];
＿＿
＿＿{ セルの寸法を取得 }
＿＿for row:= 1 to maxRow do
＿＿＿GetWSRowHeight(hWS, row, ht[row]);
＿＿for clm:= 1 to maxClm do
＿＿＿GetWSColumnWidth(hWS, clm, wd[clm]);
＿＿
＿＿{ 罫線を取得 }
＿＿for row:= 0 to maxRow do begin
＿＿＿for clm:= 0 to maxClm do begin
＿＿＿＿hLine[row, clm]:= false;
＿＿＿＿vLine[row, clm]:= false;
＿＿＿end;{for}
＿＿end;{for}
＿＿
＿{ ↓2004/8/26 修正 }
＿＿for row:= 1 to maxRow do begin
＿＿＿for rowDB:= indexRDB[row]+0 to indexRDB[row]+SubRows[row] do begin
＿＿＿＿for clm:= 1 to maxClm do begin
＿＿＿＿＿GetWSCellBorder(hWS, row, clm, top, left, bottom, right);
＿＿＿＿＿Set_or(hLine[rowDB-1, clm], top);
＿＿＿＿＿Set_or(hLine[rowDB, clm], bottom);
＿＿＿＿＿Set_or(vLine[rowDB, clm-1], left);
＿＿＿＿＿Set_or(vLine[rowDB, clm], right);
＿＿＿＿end;{for}
＿＿＿end;{for}
＿＿end;{for}
＿{ ↑2004/8/24 修正 }
end;{Init_Vars}

procedure Set_XY;{ ＸＹ座標を計算します。 }
var
＿row, rowDB, clm＿:integer;{ ----2004/8/24 rowDBを追加 }
begin
＿for clm:= 1 to maxClm do
＿x[clm]:= x[clm-1] + k * wd[clm];

{ ↓2004/8/24 修正 }
＿for row:= 1 to maxRow do
＿＿for rowDB:= indexRDB[row]+0 to indexRDB[row]+SubRows[row] do
＿＿＿y[rowDB]:= y[rowDB-1] - k * ht[row];
{ ↑2004/8/24 修正 }
end;{Set_XY}

function BeClass(cls:string):boolean;
{ クラスの有無を返します。 }
var
＿i＿:integer;
＿be＿:boolean;
begin
＿i:= 1;
＿be:= false;
＿while (i <= ClassNum) & (not be) do begin
＿＿if cls = ClassList(i) then
＿＿be:= true;
＿＿i:= i + 1;
＿end;{while}
＿BeClass:= be;
end;{BeClass}

procedure SetClassAttrs;{ ----2004/8/26 修正 }
{ クラス属性を設定します。クラスがある場合は何もしません。 }
＿
＿procedure SetClsAttr(cls:string; col, wd:integer);
＿begin
＿＿if not BeClass(cls) then begin
＿＿＿NameClass(cls);
＿＿＿SetClPenFore(cls, col);
＿＿＿SetClLW(cls, wd);
＿＿end;{if}
＿end;{SetClsAttr}
＿
begin{SetClassAttrs}
＿SetClsAttr(ClsWSGrid, GridColor, GridWidth);
＿SetClsAttr(ClsWSGridHd, GridHdColor, GridHdWidth);
＿SetClsAttr(ClsWSOutline, OutlineColor, OutlineWidth);
＿SetClsAttr(ClsWSBorder, lnColor, lnWidth);
＿SetClsAttr(ClsWSText, txtColor, 14);
end;{SetClassAttrs}

procedure DrawGrid;{ ----2004/8/24 修正 }
{ グリッドを描きます。 }
var
＿rowDB, clm＿:integer;
begin
＿BeginGroup;
＿＿for rowDB:= 1 to maxRowDB-1 do begin
＿＿＿MoveTo(x[0], y[rowDB]);
＿＿＿LineTo(x[maxClm], y[rowDB]);
＿＿end;{for}
＿＿
＿＿for clm:= 1 to maxClm-1 do begin
＿＿＿MoveTo(x[clm], y[0]);
＿＿＿LineTo(x[clm], y[maxRowDB]);
＿＿end;{for}
＿EndGroup;
end;{DrawGrid}

procedure DrawOutline;{ ----2004/8/24 修正 }
{ 外枠を描きます。 }
begin
＿Rect(x[0], y[0], x[maxClm], y[maxRowDB]);
end;{DrawOutline}

procedure DrawHBorders;{ ----2004/8/24 修正 }
{ 水平線を書きます。 }
var
＿rowDB, c1, c2＿:integer;
＿
＿function StartClm(c:integer):integer;
＿begin
＿＿repeat
＿＿＿c:= c + 1;
＿＿until (maxClm <= c) | (hLine[rowDB, c]);
＿＿if (c <= maxClm) & (hLine[rowDB, c]) then
＿＿＿StartClm:= c
＿＿else
＿＿＿StartClm:= 0;
＿end;{StartClm}
＿
＿function EndClm(c:integer):integer;
＿begin
＿＿while (c < maxClm) & hLine[rowDB, c+1] do
＿＿＿c:= c + 1;
＿＿EndClm:= c;
＿end;{EndClm}
＿
begin{DrawHBorders}
＿for rowDB:= 0 to maxRowDB do begin
＿＿c1:= StartClm(0);
＿＿while (c1 <> 0) do begin
＿＿＿c2:= EndClm(c1);
＿＿＿MoveTo(x[c1-1], y[rowDB]);
＿＿＿LineTo(x[c2], y[rowDB]);
＿＿＿c1:= StartClm(c2);
＿＿end{while}
＿end;{for}
end;{DrawHBorders}

procedure DrawVBorders;{ ----2004/8/24 修正 }
{ 垂直線を描きます。 }
var
＿clm, r1, r2＿:integer;
＿
＿function StartRow(r:integer):integer;
＿begin
＿＿repeat
＿＿＿r:= r + 1;
＿＿until (maxRowDB <= r) | (vLine[r, clm]);
＿＿if (r <= maxRowDB) & (vLine[r, clm]) then
＿＿＿StartRow:= r
＿＿else
＿＿＿StartRow:= 0;
＿end;{StartRow}
＿
＿function EndRow(r:integer):integer;
＿begin
＿＿while (r < maxRowDB) & vLine[r+1, clm] do
＿＿＿r:= r + 1;
＿＿EndRow:= r;
＿end;{EndRow}

begin{DrawVBorders}
＿for clm:= 0 to maxClm do begin
＿＿r1:= StartRow(0);
＿＿while (r1 <> 0) do begin
＿＿＿MoveTo(x[clm], y[r1-1]);
＿＿＿LineTo(x[clm], y[r2]);
＿＿＿r2:= EndRow(r1);
＿＿＿r1:= StartRow(r2);
＿＿end{while}
＿end;{for}
end;{DrawVBorders}

function CellAlign(h:handle; row, clm, subRow:integer):integer;{ ----2004/8/26 追加 }
{ セルの文字揃えを返します。 }
var
＿result＿:integer;
begin
＿GetWSCellAlignment(h, row, clm, result);
＿if result = 0 then begin
＿＿if subRow = 0 then begin
＿＿＿if CellHasNum(h, row, clm) then
＿＿＿＿result:= 3
＿＿＿else
＿＿＿＿result:= 1;
＿＿end{if}
＿＿else begin
＿＿＿if IsWSSubrowCellNumber(h, row, clm, subRow) then
＿＿＿＿result:= 3
＿＿＿else
＿＿＿＿result:= 1;
＿＿end;{else}
＿end;{if}
＿CellAlign:= result;
end;{CellAlign}

procedure DrawTexts;{ ----2004/8/26 修正 }
{ セルの文字を描きます。 }
var
＿row, rowDB, subRow, clm＿:integer;
＿cell＿:wsCell;
＿xT, yT＿:real;
begin
＿TextVerticalAlign(5);{ 下揃え }
＿for row:= 1 to maxRow do begin
＿＿for clm:= 1 to maxClm do begin
＿＿＿if (0 < wd[clm]) then begin
＿＿＿＿for subRow:= 0 to subRows[row] do begin
＿＿＿＿＿if subRow = 0 then
＿＿＿＿＿＿GetWSCellString(hWS, row, clm, cell.txt)
＿＿＿＿＿else
＿＿＿＿＿＿GetWSSubrowCellString(hWS, row, clm, subRow, cell.txt);
＿＿＿＿＿if (cell.txt <> '') then begin
＿＿＿＿＿＿GetWSCellTextFormat(hWS, row, clm, cell.fontID, cell.size, cell.style);
＿＿＿＿＿＿cell.align:= CellAlign(hWS, row, clm, subRow);
＿＿＿＿＿＿case cell.align of
＿＿＿＿＿＿＿0, 1: xT:= x[clm-1] + k * LeftMargin;
＿＿＿＿＿＿＿2: xT:= (x[clm-1] + x[clm]) / 2;
＿＿＿＿＿＿＿3: xT:= x[clm] - k * RightMargin;
＿＿＿＿＿＿end;{case}
＿＿＿＿＿＿rowDB:= row2rowDB(row, subRow);
＿＿＿＿＿＿yT:= y[rowDB];
＿＿＿＿＿＿TextJust(cell.align);
＿＿＿＿＿＿TextFont(cell.fontID);
＿＿＿＿＿＿TextSize(cell.size);
＿＿＿＿＿＿TextOrigin(xT, yT);
＿＿＿＿＿＿CreateText(cell.txt);
＿＿＿＿＿＿SetTextStyle(LNewObj, 0, GetTextLength(LNewObj), cell.style);
＿＿＿＿＿end;{if}
＿＿＿＿end;{for}
＿＿＿end;{if}
＿＿end;{for}
＿end{for}
end;{DrawTexts}

begin{main}
＿GetWSHandle(hWS, hTbl);
＿if hWS = nil then begin
＿＿AlrtDialog('ワークシートを開くか、選択してください。');
＿end{if}
＿else begin{ グループ図形を描く }
＿＿PushAttrs;
＿＿DSelectAll;
＿＿Set_k;
＿＿Init_Vars;
＿＿if hTbl = nil then begin
＿＿＿Message('図形を描く位置（左上）をクリックしてください。');
＿＿＿GetPt(x[0], y[0]);
＿＿end{if}
＿＿else begin
＿＿＿GetBBox(hTbl, x[0], y[0], x[maxClm], y[maxRow]);
＿＿end;{else}
＿＿Set_XY;
＿＿SetClassAttrs;
＿＿BeginGroup;
＿＿＿FillPat(0);
＿＿＿LSByClass;
＿＿＿LWByClass;
＿＿＿PenColorByClass;
＿＿＿NameClass(ClsWSText);
＿＿＿DrawTexts;
＿＿＿if GetObjectVariableBoolean(hWS, ShowGrid) then{ ----2004/8/26 追加 }
＿＿＿＿NameClass(ClsWSGrid)
＿＿＿else
＿＿＿＿NameClass(ClsWSGridHd);
＿＿＿DrawGrid;
＿＿＿NameClass(ClsWSBorder);
＿＿＿BeginGroup;
＿＿＿＿DrawHBorders;
＿＿＿＿DrawVBorders;
＿＿＿EndGroup;
＿＿＿NameClass(ClsWSOutline);
＿＿＿DrawOutline;
＿＿EndGroup;
＿＿if hTbl <> nil then
＿＿＿DelObject(hTbl)
＿＿else
＿＿＿ClrMessage;
＿＿PopAttrs;
＿＿ReDrawAll;
＿end;{else}
end;{main}
Run(WS_to_GroupObj);

以前、与太郎さんが提供してくれたWSをグループ図形に変換するおまじないについて
質問なのですが、サブルーチンのDrawGridとDrawHBorders、DrawVBordersは何か
違いがあるのですか？

他のCADのデータを取り込んで、テキストが分解されていた時などに使えます。
文字のフォント、サイズ、スタイルは元の属性を再現できましたが、色は再現できませんでした。
（GetTextColor、SetTextColorに相当するサブルーチンがないため）

procedure JoinText;
{ クリックした文字を一つにまとめます。 }
{ Option(Alt)キーを押しながらクリックすると、間にスペースを挿入します。 }
{ 文字以外をクリックすると終了します。 }
{$ DEBUG}
const
TextObj = 10;
var
＿x, y＿:real;
＿h0, h＿:handle;
＿str, str0＿:string;
＿lg0, lg＿:integer;
＿fID, fSize, fStyle＿:integer;
＿i, j＿:integer;
begin
＿Message('最初の文字をクリックしてください。');
＿DSelectAll;
＿GetPt(x, y);
＿h0:= PickObject(x, y);
＿if h0 <> nil then begin
＿＿if GetType(h0) = TextObj then begin
＿＿＿SetSelect(h0);
＿＿＿ReDraw;
＿＿＿str0:= GetText(h0);
＿＿＿lg0:= Len(str0);
＿＿＿Message('次の文字をクリックしてください。');
＿＿＿GetPt(x, y);
＿＿＿h:= PickObject(x, y);
＿＿＿while h <> nil do begin
＿＿＿＿if GetType(h) = TextObj then begin
＿＿＿＿＿if Option then begin
＿＿＿＿＿＿str0:= Concat(str0, ' ');
＿＿＿＿＿＿lg0:= lg0 + 1;
＿＿＿＿＿end;{if}
＿＿＿＿＿str:= GetText(h);
＿＿＿＿＿lg:= Len(str);
＿＿＿＿＿if (lg0+lg) > 255 then begin
＿＿＿＿＿＿AlrtDialog('255文字を超えてしまいました。');
＿＿＿＿＿end{if}
＿＿＿＿＿else begin
＿＿＿＿＿＿str0:= Concat(str0, str);
＿＿＿＿＿＿SetText(h0, str0);
＿＿＿＿＿＿for i:= 0 to lg-1 do begin
＿＿＿＿＿＿＿fID:= GetTextFont(h, i);
＿＿＿＿＿＿＿fSize:= GetTextSize(h, i);
＿＿＿＿＿＿＿fStyle:= GetTextStyle(h, i);
＿＿＿＿＿＿＿SetTextFont(h0, lg0+i, 1, fID);
＿＿＿＿＿＿＿SetTextSize(h0, lg0+i, 1, fSize);
＿＿＿＿＿＿＿SetTextStyle(h0, lg0+i, 1, fStyle);
＿＿＿＿＿＿end;{for}
＿＿＿＿＿＿lg0:= lg0 + lg;
＿＿＿＿＿＿DelObject(h);
＿＿＿＿＿＿ReDraw;
＿＿＿＿＿end;{else}
＿＿＿＿end{if}
＿＿＿＿else begin
＿＿＿＿＿AlrtDialog('文字図形をクリックしてください。');
＿＿＿＿end;{else}
＿＿＿＿GetPt(x, y);
＿＿＿＿h:= PickObject(x, y);
＿＿＿end;{while}
＿＿end{if}
＿＿else begin
＿＿＿AlrtDialog('文字図形をクリックしてください。');
＿＿end;{else}
＿end;{if}
＿ReDrawAll;
＿ClrMessage;
end;
Run(JoinText);

２バイト文字対応版です。
２バイト文字の上位バイトは129〜159と224〜252の範囲です。
（下位バイトの範囲は64〜126と128〜252ですが、今回は必要ありません。）

procedure TaperText;{ 文字図形にテーパーを付けます }
{$ DEBUG}
const
K = -1.5;
Kt = 1/4;{ テーパー比 = 1/4 }
var
h:handle;
sz1, sz2:integer;
i, lg:integer;
k1, k2:real;
s:string;
c:char;
bt:integer;
begin
h:= FSActLayer;
if (h <> nil) & (GetType(h) = 10) then begin
s:= GetText(h);
lg:= GetTextLength(h);
sz1:= GetTextSize(h, 0);
sz2:= sz1 * Kt;
k1:= sz1 * (k);
k2:= (sz2-sz1-k1);
i:= 0;
while (i <= lg-1) do begin
c:= copy(s, i+1, 1);
case Ord(c) of
129..159, 224..252: bt:= 2;
otherwise bt:= 1;
end;{case}
SetTextSize(h, i, bt, sz1 + k2*(i/(lg-1))^2 + K1*(i/(lg-1)));
i:= i + bt;
end;{while}
ReDrawAll;
end;{if}
end;
Run(TaperText);

当然ながら、サイズがゼロより小さくなる設定にすると、表示がおかしくなります。

アクティブレイヤで一番上の選択文字図形にテーパーを付けます。

procedure TaperText;{ 文字図形にテーパーを付けます }
{$ DEBUG}
const
K = -1.5;
Kt = 1/4;{ テーパー比 = 1/4 }
var
h:handle;
sz1, sz2:integer;
i, lg:integer;
k1, k2:real;
begin
h:= FSActLayer;
if (h <> nil) & (GetType(h) = 10) then begin
lg:= GetTextLength(h);
sz1:= GetTextSize(h, 0);
sz2:= sz1 * Kt;
k1:= sz1 * (k);
k2:= (sz2-sz1-k1);
for i:= 1 to lg-1 do begin
SetTextSize(h, i, 1, sz1 + k2*(i/lg)^2 + K1*(i/lg));
end;{for}
ReDrawAll;
end;{if}
end;
Run(TaperText);

k を変えるとテーパー形状が変わります。大きくすると膨らみます。
残念ながら、２バイト文字には対応しておりません。実行すると変になります。
対応させるには、１バイト文字か２バイト文字かを調べないといけません。

おかしいですね。
古いバージョンだと、Write()の引数に関数を使えなかったりしたので、
const Tab1 = Char(9);
　・
　・
　・
Write( s , Tab1 , s2 , Tab1...);
としてみたらどうでしょうか。

もしだめでも、
Write(s); Tab(1);
Write(s2); Tab(1);
　・
　・
　・
とすれば大丈夫だと思います。

表計算ソフトにコピペ出来たり、データの内容を問わない等の理由から、タブ区切り
テキストは最強のデータフォーマットです。是非あきらめずにやってみてください。

一行タブ区切り読み込みはお役に立ちましたか。標準のReed()がブラックボックスで、
いろいろ試してみるのも面倒なので、自前の関数を書きました。

テキスト吐き出しで、Write( s , Chr(9) , s2 , Chr(9)...));と言ったように
タブ区切りを行うと、うまくタブが書き込まれないようですがバグですかね？
仕方がないのでカンマ区切りで逃げましたが、その際に与太郎さんの一行タブ区切り
読み込みを使わせていただきました...（礼）

VW10.5 MacOS 10.3.2

数式を計算する関数がない問題は、ExcelにTextCalcを組み込むことで解決できました。この関数マクロは
VBAで書かれています。どうやら数式を括弧、数字、演算子の要素に切り分けて、自前のルーチンで計算し
ているようです。VBAだとこうするしかなかったのでしょうか？
与太郎のCalcStr()は、VBA対応以前だったので、Excel4.0マクロという形式で作りました。EVALUTE()
という、数式文字列を計算するマクロ関数を使ったので、計算ルーチンは書いていません。Excel4.0マクロ
で自前の計算ルーチンを書くのは、困難だったろうと思います（特にデバッグが）。

Excel4.0マクロは、マクロシートに作成します。ところが、MicroSoftはExcel4.0マクロを使わせたくな
いようで、以前は「挿入」メニューに「マクロシート」という項目があったのが、現在ではなくなっていま
す。マクロシートを作るには、ワークシートのタブを右クリックして、コンテキストメニューの「挿入...」
で 「Excel4.0マクロ」を選択します。マクロシートの見かけはワークシートと変わりません。ワークシー
トでは使えないマクロ関数が使えるのが違いです。マクロを入力するときは、値より数式を表示したほうが
見やすいので、「オプション...」または「初期設定...」で「数式」をチェックします。

以下が関数マクロ「CalcStr」です。上から順番に実行する単純なマクロで、ループも分枝もありません。
マクロはB1〜B38セルに入力します。テキストエディタで＿をタブに変換すれば、マクロシートにコピペ出
来ます。

B1:　＿CalcStr＿数式文字列を計算する
B2:　＿=RESULT(1)＿関数の返り値（１は実数型）
B3:　＿=ARGUMENT("STR", 2)＿関数の引数を変数STRに代入（２は文字列型）
B4:　＿=STR＿デバッグ用にSTRを表示。（以下も同様）
B5:　＿STR=LOWER(STR)＿大文字を小文字に変換
B6:　＿=STR
B7:　＿STR=ASC(STR)＿全角文字を半角文字に変換
B8:　＿=STR
B9:　＿STR=SUBSTITUTE(STR," ","")＿空白をヌル文字に置き換える。（他も同様）
B10: ＿=STR
B11: ＿STR=SUBSTITUTE(STR,"{","(")
B12: ＿STR=SUBSTITUTE(STR,"}",")")
B13: ＿STR=SUBSTITUTE(STR,"[","(")
B14: ＿STR=SUBSTITUTE(STR,"]",")")
B15: ＿=STR
B16: ＿STR=SUBSTITUTE(STR,"x","*")
B17: ＿STR=SUBSTITUTE(STR,"×","*")
B18: ＿STR=SUBSTITUTE(STR,"÷","/")
B19: ＿STR=SUBSTITUTE(STR,"＋","+")
B20: ＿STR=SUBSTITUTE(STR,"−","-")
B21: ＿STR=SUBSTITUTE(STR,"･","*")
B22: ＿=STR
B23: ＿STR=SUBSTITUTE(STR,"√","SQRT")
B24: ＿=STR
B25: ＿STR=SUBSTITUTE(STR,"π","PI()")
B26: ＿=STR
B27: ＿STR=SUBSTITUTE(STR,"°","°")＿半角カナの"°"を（度）に置き換えてますが、掲示板なので自粛。
B28: ＿STR=SUBSTITUTE(STR,"°","*pi()/180")
B29: ＿=STR
B30: ＿STR=SUBSTITUTE(STR,"tan-1","arctan")
B31: ＿STR=SUBSTITUTE(STR,"sin-1","arcsin")
B32: ＿STR=SUBSTITUTE(STR,"cos-1","arccos")
B33: ＿=STR
B34: ＿STR=SUBSTITUTE(STR,"/arc","/180*pi()/a")＿角度を度で返すための置き換え（下の行も）
B35: ＿STR=SUBSTITUTE(STR,"arc","180/pi()*a")
B36: ＿=STR
B37: ＿=EVALUATE("="&STR)＿数式を計算。文字列の形式はセルに入れる式と同じで、先頭に＝が必要。
B38: ＿=RETURN(B37)＿B37セルの値を返して終了。

マクロ関数の定義は、B1〜B38セルを選択して、「挿入」−「名前」−「定義...」で行います。そのとき、
「マクロの実行」グループ内の「関数」をチェックします。終わったら保存します。

最初に実行する前に、マクロシートを値表示に戻しておきます。
A1セルに数式を入れ、B1セルに「=CalcStr(A1)」と入れます。
きちんと計算されてたら（されてなくても）、マクロシートを見てください。文字がどう置き換えられてい
くかを確認出来ます。

マクロ関数をアドインにするには、「ファイル」−「別名で保存...」で、フォーマットを「MicroSoft Excel
アドイン」として、所定のフォルダに保存します（フォルダはExcelのバージョンやOSによって異なります）。
アドインをExcelに登録するには、Excelを再起動して、「ツール」−「アドイン」で「CalcStr」をチェック
します。以後は普通のExcel関数とおなじようにCalcStr()を使えます。

TextCalcと比べて単純なので、トラブルも少ないかもです。

ARcoatingさん、「Textcalc」の御紹介ありがとうございました！
似たような関数を誰かが作ってるだろうと思ってましたが、本気で探してなかったということもあっ
て、今まで見つけられませんでした。
アドオンですと、使い勝手がいいですね。
マクロシートだと、関数名の前にマクロファイルの名前を付ける必要があるのでした。
例：　=CalcStr() → =MacroFile!CalcStr()
コピペすればいいので，今までそれほど不便と思わずに使っておりましたが、やっぱり不便でした。
今からでも（遅蒔きながら）アドインにしてみるつもりです。

こんにちは、お久しぶりです！
エクセルの数式について、私も積算時にいつも往生しております、、、。
最近は与太郎さんが言われているCalcStr()の様なもの？を利用しております。
フリーの関数アドインで「Textcalc」というのをエクセル登録して利用させてもらってます。
http://homepage3.nifty.com/peace/
動作が重くなったり、たまに数式エラーがでますがなかなか優秀です。
ご参考までに、、。

VWと関係ない話ですが...
みなさんは、Excelで数式を書くときはどうされているでしょうか？
たとえば、 12.00 x 4.00 x 2.50 = 120.00(m3) と書く場合、
┌─┬─────┬─┬────┬─┬────┬─┬─────
│　│＿＿Ａ＿＿│Ｂ│＿Ｃ＿＿│Ｄ│＿Ｅ＿＿│Ｆ│＿＿Ｇ＿＿
├─┼─────┼─┼────┼─┼────┼─┼─────
│１│１２．００│ｘ│４．００│ｘ│２．５０│＝│=A1*C1*E1
└─┴─────┴─┴────┴─┴────┴─┴─────
とするのが一般的だと思います。この方法だと、同じ形式のデータが何行もあるときに、縦方向が揃って
綺麗です。

しかし、三角形や台形の式が混じった場合は面倒なことになります。たとえば、
12.00 x 4.00 x 2.50 = 120.00
10.50 x 6.00 x 3.50 / 2 = 110.25
6.50 x 4.00 x ( 5.50 + 3.00 ) / 2 = 110.50
のような場合（コンクリート体積等の計算式が必要なので、こういうのが結構あります）、
┌─┬─────┬─┬────┬──┬────┬─┬────┬──┬─┬─┬─────────
│　│＿＿Ａ＿＿│Ｂ│＿Ｃ＿＿│Ｄ＿│＿Ｅ＿＿│Ｆ│＿Ｇ＿＿│Ｈ＿│Ｉ│Ｊ│＿＿＿＿Ｋ＿＿＿＿
├─┼─────┼─┼────┼──┼────┼─┼────┼──┼─┼─┼─────────
│１│１２．００│ｘ│４．００│ｘ　│２．５０│　│＿＿＿＿│＿＿│＿│＝│=A1*C1*E1
├─┼─────┼─┼────┼──┼────┼─┼────┼──┼─┼─┼─────────
│２│１０．５０│ｘ│６．００│ｘ　│３．５０│／│２＿＿＿│＿＿│＿│＝│=A2*C2*E2/G2
├─┼─────┼─┼────┼──┼────┼─┼────┼──┼─┼─┼─────────
│３│　６．５０│ｘ│４．００│ｘ（│５．５０│＋│３．００│）／│２│＝│=A3*C3*(E3+G3)/I3
└─┴─────┴─┴────┴──┴────┴─┴────┴──┴─┴─┴─────────
という具合になるでしょうか。もちろん、Ｄ列やＨ列を工夫して、"x"と"x("や、"="と")="を自動的に書
き分けたり、条件式を使ってＫ列を一つの計算式で済ませることは出来ますが、ワークシートはますます
複雑になります。ミスも多くなりそうです。

ワークシートを単純にするには、
┌─┬───────────────────────┬─┬──────
│　│＿＿＿＿＿＿＿＿＿＿＿Ａ＿＿＿＿＿＿＿＿＿＿＿│Ｂ│＿＿Ｃ＿＿＿
├─┼───────────────────────┼─┼──────
│１│１２．００ｘ４．００ｘ２．５０＿＿＿＿＿＿＿＿│＝│=CalcStr(A1)
├─┼───────────────────────┼─┼──────
│２│１０．５０ｘ６．００ｘ３．５０／２＿＿＿＿＿＿│＝│=CalcStr(A2)
├─┼───────────────────────┼─┼──────
│３│６．５０ｘ４．００ｘ（５．５０＋３．００）／２│＝│=CalcStr(A3)
└─┴───────────────────────┴─┴──────
とすることです。この方法だと縦方向は揃いませんが、どんな式が並んでも、ワークシートは単純な構成
になります。式の入力さえ間違えなければ、計算間違いもありません。

問題は、Excelに CalcStr()という関数がないことです。ってそれじゃ意味ないじゃん。

（来週に続く。）

＞今ではHiBaseでこと足りているので、他のアプリは使っていません...。
そう、東京のオフ会のネタはHiBaseで那須の麓でBBQをしながらHiBaseの
使い方のレクチャーということにしません？
羽田氏絶賛の黒磯の温泉まんじゅうと屋外プール顔負けの北温泉それに
帰り道には宇都宮のみんみんの餃子とネタには困らない豪華ツアー付き
紅葉前線の南下の前に（お山での凍死を避けるために）関東の尖り好みの
皆さんいかがでしょう？
サンプルのHiBaseがいまいちピンときていなんですよ。それなもんで
そこからまでとそこからどうなるのがすごく気になるんです。
最低予定人数3名様程度でいかがですか。東京のXOOPがへそを曲げているので
ここのカフェテラスに話題を移したいと思います。

＞石男さん
VWで作図 → FileMakerで見積り作成ですか。完全自動化なら羨ましい。

こちらは、アプリ間の連携は「コピペ」です。あとはスクリプトでレイヤ毎の断面数量をテキスト
ファイルに書き出すくらいです。それをExcelに貼り付けて、ごちゃごちゃやって、数量計算書に
しています。転記ミスがないだけましというレベルです。
VWの断面図とExcelの計算書を連動させるなんて、夢の夢です。

一時、DBにはまって？いた時は、VSでテキストファイルを取り出しFileMakerに読み込
ませていました。この一連の流れをAppleScriptで制御していました。これはExcelでも
同じように出来す、ただWinですとアプリ間を連携させるScriptがあるかな〜。
VSはVBに対応していないし...。
今ではHiBaseでこと足りているので、他のアプリは使っていません...。

＞一休さん
ひとくちにデータベースといっても、データベースソフト、表計算ソフト、テキストファイルなど、
いろいろな方法があると思うのですが、一休さんはExcelで作られてるのですか。（こっそりと）詳し
く教えていただけたら、お助けできるかもしれません。
といっても、与太郎は何年も前にFileMakerと4thDimensionを触ったことがあるだけで、実際に使った
こともないので、あまり役に立てない可能性も大です。半分興味本位ですが、お許しを（^_^）。

あっ間違えてリターンを押してしまった。

IsWSSubrowCellString() と IsWSSubrowCellNumber() でＤＢ従属行も調査できましたね。
失礼いたしました。

IsWSSubrowCellString()

↓やっぱりデータベースって使うんだ（私は使わないんですが）。
というわけで、WS_to_GroupObj を、データベースの従属行も表示出来るように修正しました。

ただし、位置揃えが標準で、従属行が文字データの場合、左揃えで表示しないといけないのですが、
データベースのヘッダ行が数値データのため、右揃えで表示してしまいます。
CellHasNum()、CellHasStr() ではヘッダ行しか調べられないので、仕方ありませんが、もしも解決
法をご存知の方がいらっしゃいましたら、教えていただけたら助かります。

ということで、ソースの書き込みはしばらく待ってみます（ご要望があれば別ですが）。
400行近くなってしまったため、何度も書き込むのも何なので...。

ODBC経由FileMakerとHiBaseでの図形データベースの道があるのですが
難解でよく解っていません。
ODBC経由FileMakerは
http://www.aecmgr.com/pages/2/index.htm
HiBaseは製品版のVW10から紹介されています。
ホロン社はhttp://www.hln.co.jp/hibase/index.htmlですが
Mac OSX Server版の開発が遅れていることなどで利用体制が
整っていません。ここまでこっそりばらしたんですから一休さんが
この世界の第一人者への道に乗ってしまいましたのでがんばってくださいね。

　今までは、ワークシートの数量をタブ区切りにエクスポートしてエクセルでインポートという作業をしていますが、もっと他のソフトとの連携がうまくいく方法ありませんかね？
　ベクターなんだかでエクスポートしたらデータベースの値も変わるという連携は
可能でしょうか？　もし可能でしたら、その組み合わせ、エクスポート形式を教えていただけないでしょうか？　しかもこっそり笑

MC7までは問題なかったのですが、VW8以降、クラス名にハイフンを含んでいるとサブメニューに
なってしまい選択しづらいので、こんなスクリプトを作ってみました。PIMにして、ショートカット
キーを割り当てて使います。
VW10からはアクティブクラスをショートカットキーで変更できるようになったので、このスクリプ
トは必要ありません。

クラスの並べ替えにマージソート（みたいなもの）を使っていますが、普通こんなところでは使いま
せん。100個程度のデータのソートなら、どんなソートアルゴリズムでも一瞬で済むので、最も簡単
なアルゴリズムを使うべきでした。あと、文字列の大小を < や > 比較できれなかったので、LargeStr
で比較しています。

一応クラス数は255までとしています。私自身は50個もあれば十分ですが、3Dの建築で建具のテクス
チャー毎にクラスを作ったりすると255個を超えたりするのでしょうか？

じつは、スクリプトの最後の Layer(GetLName(ActLayer)); がないと、スクリプト実行後、マウスを
動かさないとデータバーのクラスの表示が変わりません（VW8.5/Mac）。それで今まで発表を控えて
いました。クラス変更後に図形を描けばクラス表示も更新されるので、図形を描いた後 DelObject
で削除したり、Redraw したり色々試してみましたがダメでした。それでずっとそのまま使っていまし
たが、数日前、アクティブレイヤを変更して、また戻せばクラス表示が更新されるのに気付きました。
結局、Layer(); を実行すれば良いと判ったので、最後に１行を追加しました。

procedure ActiveNextClass;
{ 「次のクラス」コマンド }
const
＿MaxClassNum = 255;
var
＿act＿:string;
＿i, n＿:integer;
＿cls＿:array[1..MaxClassNum] of string;
＿
＿procedure SwapStr(var s1, s2:string);{ ２つの文字列変数の中身を入れ替える。 }
＿var
＿＿s＿:string;
＿begin
＿＿s:= s2;
＿＿s2:= s1;
＿＿s1:= s;
＿end;{SwapStr}
＿
＿function LargeStr(s1, s2:string):boolean;{ s1がs2より大きければTrueを返す。 }
＿var
＿＿i＿:integer;
＿＿lg＿:integer;
＿＿n, n1, n2＿:integer;
＿＿c1, c2＿:char;
＿begin
＿＿n1:= Len(s1);
＿＿n2:= Len(s2);
＿＿if n1 < n2 then
＿＿＿n:= n1
＿＿else
＿＿＿n:= n2;
＿＿lg:= 0;
＿＿i:= 1;
＿＿while (lg = 0) & (i <= n) do begin
＿＿＿c1:= Copy(s1, i, 1);
＿＿＿c2:= Copy(s2, i, 1);
＿＿＿if Ord(c1) > Ord(c2) then
＿＿＿＿lg:= 1
＿＿＿else if Ord(c1) < Ord(c2) then
＿＿＿＿lg:= -1;
＿＿＿i:= i + 1;
＿＿end;
＿＿case lg of
＿＿＿-1:＿LargeStr:= false;
＿＿＿0:＿if n1 > n2 then
＿＿＿＿＿LargeStr:= true
＿＿＿＿else
＿＿＿＿＿LargeStr:= false;
＿＿＿1:＿LargeStr:= true;
＿＿end;
＿end;{LargeStr}
＿
＿procedure MargeCls(st1, ed1, st2, ed2:integer);{ 配列clsのst1からed1の範囲と、st2からed2の範囲を
ソートする。 ただし、st2 = ed1 + 1 }
＿var
＿＿i, j, i1, i2:integer;
＿＿s＿:array[1..MaxClassNum] of string;
＿begin
＿＿i1:= st1;
＿＿i2:= st2;
＿＿i:= st1;
＿＿while (i <= ed2) do begin
＿＿＿if LargeStr(cls[i1], cls[i2]) then begin
＿＿＿＿s[i]:= cls[i2];
＿＿＿＿if i2 < ed2 then
＿＿＿＿＿i2:= i2 + 1
＿＿＿＿else
＿＿＿＿＿cls[i2]:= chr(255);
＿＿＿end
＿＿＿else begin
＿＿＿＿s[i]:= cls[i1];
＿＿＿＿if i1 < ed1 then
＿＿＿＿＿i1:= i1 + 1
＿＿＿＿else
＿＿＿＿＿cls[i1]:= chr(255);
＿＿＿end;
＿＿＿i:= i + 1;
＿＿end;
＿＿for i:= st1 to ed2 do
＿＿＿cls[i]:= s[i];
＿end;{MargeCls}
＿
＿procedure SortCls(st, ed:integer);{ 配列clsのstからedの範囲をソートする。 }
＿var
＿＿st1, ed1, st2, ed2＿:integer;
＿begin
＿＿if 1 < (ed-st) then begin
＿＿＿st1:= st;
＿＿＿ed1:= (ed + st) div 2;
＿＿＿st2:= ed1 + 1;
＿＿＿ed2:= ed;
＿＿＿SortCls(st1, ed1);
＿＿＿SortCls(st2, ed2);
＿＿＿MargeCls(st1, ed1, st2, ed2);
＿＿end
＿＿else if 1 = (ed-st) then begin
＿＿＿if LargeStr(cls[st], cls[ed]) then
＿＿＿＿SwapStr(cls[st], cls[ed]);
＿＿end;
＿end;{SortCls}
＿
begin{main}
＿act:= ActiveClass;
＿n:= ClassNum;
＿for i:= 1 to n do begin
＿＿cls[i]:= ClassList(i);
＿＿if cls[i] = '' then
＿＿＿cls[i]:= '一般';
＿end;
＿SortCls(1, n);{ VW9以降ならSortArrayが使える？　使えたらサブルーチンは不要。 }
＿i:= 1;
＿while (i < n) & (act <> cls[i]) do
＿＿i:= i + 1;
＿if act = cls[i] then begin
＿＿if i < n then
＿＿＿i:= i + 1
＿＿else
＿＿＿i:= 1;
＿end;
＿NameClass(cls[i]);
＿Layer(GetLName(ActLayer));{ データバーの更新に必要。 }
end;{main}
Run(ActiveNextClass);

けっこう長いスクリプトですが、大半はクラス名をソートするサブルーチンです。

ForEachObject...を使わずに全図形にアクセスする方法を考えてみました。
動作確認はしていません。それに、たぶんForEachObject...を使ったほうが簡単です。

procedure DelHideClassObj;
{ 表示してないクラス（＆グレー）の図形を削除します。 }
{ グループ内の図形も削除しますが、グループ図形自体は削除しません。 }
var
＿h＿:handle;
＿
＿procedure DoObject(h:handle);
＿{ ForEachObject...でいう、actionFuncです。 }
＿{ このスクリプトでは、表示してないクラスの図形を削除します。 }
＿＿
＿＿function IsHideObj(h:handle):boolean;
＿＿var
＿＿＿result＿:boolean;
＿＿begin
＿＿＿if GetCVis(GetClass(h)) = 0 then
＿＿＿＿result:= false
＿＿＿else
＿＿＿＿result:= true;
＿＿＿IsHideObj:= result;
＿＿end;{IsHideObj}
＿
＿begin{DoObject}
＿＿if IsHideObj(h) then
＿＿＿DelObject(h);
＿end;{DoObject}
＿
＿procedure DoRepeat(h:handle);
＿var
＿＿hC＿:handle;
＿begin
＿＿while h <> nil do begin
＿＿＿case GetType(h) of
＿＿＿＿11: begin hC:= FInGroup(h); DoRepeat(hC); h:= NextObj(h); end;{ グループ }
＿＿＿＿16: begin hC:= FInSymDef(h); DoRepeat(hC); h:= NextSymDef(h); end;{ シンボル定義 }
＿＿＿＿31: begin hC:= FInLayer(h); DoRepeat(hC); h:= NextLayer(h); end;{ レイヤー }
＿＿＿＿92: begin hC:= FInFolder(h); DoRepeat(hC); h:= NextSymDef(h); end;{ シンボルフォルダ }
＿＿＿＿otherwise begin DoObject(h); h:= NextObj(h); end;{ その他 }
＿＿＿end;{case}
＿＿end;{while}
＿end;{DoRepeat}
＿
begin{main}
＿h:= FLayer; DoRepeat(h);{ ForEachObjectInLayerと同等。全レイヤの図形を処理する。 }
＿h:= FSymDef; DoRepeat(h);{ ForEachObjectInListと同等。全シンボル定義内の図形を処理する。 }
end;{main}
Run(DelHideClassObj);

ところで、（全然別の話ですが、）
h:=GetParent(レイヤーハンドル); で返ってくるハンドルのタイプが32になっていますが、これは書類
（ファイル）のハンドルと考えて良いのでしょうか？
だとしても、データベースを割り当てるくらいしか出来ませんし（出来るかどうかは未確認です）、出
来たとしても、非公開の情報なので、バージョンアップでどう転んでも文句はいえません。

ですが、
layerHandle:=FLayer(documentHandle); などと出来ると、マルチドキュメントなスクリプトが書けるの
ですがね。NextDocment()、ActDocment、FDocment、GetDocName()、NumDocment などの関数があれば、
ファイル間で図形を移動（コピー）したりとか、色々出来そうです。
反面、スクリプトのバグで開いている書類が全滅、という事態もありえますが。

メッシュデータから３Ｄ基準点を描きます。

1. 元のデータを用意する。
一応10mのメッシュとしておきます。（側点間=10m）
┌─┬────┬─────┬─────┬─────┬
│＿│＿＿Ａ＿│＿＿Ｂ＿＿│＿＿Ｃ＿＿│＿＿Ｄ＿＿│
├─┼────┼─────┼─────┼─────┼
│１│　Ｙ＼Ｘ│−１０．０│＿＿０．０│＋１０．０│
├─┼────┼─────┼─────┼─────┼
│２│１０．０│＿＿０．０│＿−０．５│＿−１．１│
├─┼────┼─────┼─────┼─────┼
│３│２０．０│＿−０．６│＿−１．１│＿−１．７│
├─┼────┼─────┼─────┼─────┼
│４│３０．０│＿−１．１│＿−１．６│＿−２．２│
├─┼────┼─────┼─────┼─────┼

2. B12〜D14セルに式を入れる。
セル:B12　="Locus3D(" & B$1 & ", " & $A3 & ", " & B2 & ");"
残りのセルはB12セルをコピペします。

結果は下のようになります。
セル:B12〜D12　Locus3D(-10, 10, 0); Locus3D(0, 10, -0.5); Locus3D(10, 10, -1.1);
セル:B13〜D13　Locus3D(-10, 20, -0.6); Locus3D(0, 20, -1.1); Locus3D(10, 20, -1.7);
セル:B14〜D14　Locus3D(-10, 30, -1.1); Locus3D(0, 30, -1.6); Locus3D(10, 30, -2.2);

以下省略。

メッシュデータから複数の断面の地盤線を描きます。
レイヤ名＝断面の名前＝測点番号とします。

1. 元のデータを用意する。
一応10mのメッシュとしておきます。（側点間=10m）
┌─┬────┬─────┬─────┬─────┬
│＿│＿＿Ａ＿│＿＿Ｂ＿＿│＿＿Ｃ＿＿│＿＿Ｄ＿＿│
├─┼────┼─────┼─────┼─────┼
│１│＿＿＿＿│−１０．０│＿＿０．０│＋１０．０│
├─┼────┼─────┼─────┼─────┼
│２│測点番号│＿＿＿＿＿│＿＿＿＿＿│＿＿＿＿＿│
├─┼────┼─────┼─────┼─────┼
│３│Ｎｏ．１│＿＿０．０│＿−０．５│＿−１．１│
├─┼────┼─────┼─────┼─────┼
│４│Ｎｏ．２│＿−０．６│＿−１．１│＿−１．７│
├─┼────┼─────┼─────┼─────┼
│５│Ｎｏ．３│＿−１．１│＿−１．６│＿−２．２│
├─┼────┼─────┼─────┼─────┼

2. E3〜F5セルに式を入れる。
セル:E3　="Layer('" & A3 & "');"
セル:E4　="Layer('" & A4 & "');"
セル:E5　="Layer('" & A5 & "');"
セル:F3　="Poly(" & B$1 & ", " & B3 & ", " & C$1 & ", " & C3 & ", " & D$1 & ", " & D3 & ");"
セル:F4　="Poly(" & B$1 & ", " & B4 & ", " & C$1 & ", " & C4 & ", " & D$1 & ", " & D4 & ");"
セル:F5　="Poly(" & B$1 & ", " & B5 & ", " & C$1 & ", " & C5 & ", " & D$1 & ", " & D5 & ");"
４行目以降は３行目をコピペすればＯＫです。

B1とかC1でなく、B$1やC$1と書く理由は、３行目をタイプして４行目以下にコピぺしたときに、B2と
かC2に変わらないようにするためです。B3やC3はコピぺしたときにB4やC4に変わってほしいので、$
は入れません。

結果は下のようになります。
Layer('No.1'); Poly(-10 , 0, 0, -0.5, 10, -1.1);
Layer('No.2'); Poly(-10, -0.6, 0, -1.1, 10, -1.7);
Layer('No.3'); Poly(-10, -1.1, 0, -1.6, 10, -2.2);
スクリプトの先頭には、OpenPoly; と書いておきます。
実行すると、指定したレイヤに地盤線を描いてくれます。レイヤがなければ新しく作ってくれます。
ただし新しいレイヤは一番上に作られるので、レイヤの順番を確認する必要はあります。


ところで上の方法だと，横方向のデータが増えたとき、式が長くてたいへんです。次のようにすると、
セルは増えますが式は簡単になります。また、ワークシートが横に広がりすぎるので、縦方向を合わ
せて、データと式を同じ列にします。ここでは式の行はデータの10行下にしておきます。
セル:A13　="Layer('" & A3 & "'); "
セル:B13　=A13 & "Poly(" & B$1 & ", " & B3
セル:C13　=B13 & ", " & C$1 & ", " & C3
セル:D13　=C13 & ", " & D$1 & ", " & D3
セル:E13　=D13 & ");"
セル幅がせまくてＡ列〜Ｄ列の結果が表示できませんが、途中結果なので構いません。Ｅ列が最終結
果です。

結果は、
セル:A13　Layer('No.1'); Poly(
セル:B13　Layer('No.1'); Poly(-10 , 0
セル:C13　Layer('No.1'); Poly(-10 , 0, 0, -0.5
セル:D13　Layer('No.1'); Poly(-10 , 0, 0, -0.5, 10, -1.1
セル:E13　Layer('No.1'); Poly(-10 , 0, 0, -0.5, 10, -1.1);
となります。
テキストエディタにはＥ列だけコピペします。

頂点データを増やすときは、最初にＥ列をデータの右隣にコピペ（移動ではない）しておき、Ｃ列か
Ｄ列を残りの列にコピペします。

全部を一つのレイヤに描かせて多段柱状体にすれば、３Ｄの地盤を作ることも出来ます。

多角形の頂点にシンボルを描きます。（多角形は描きません）
シンボルはスクリプトを実行する前に作っておきます。シンボル名は「頂点シンボル」と
しておきます。ついでに名前（ps1、ps2、ps3）も付けます。

1. 元のデータを用意する。
┌─┬────┬──────┬─────┬─────┬─────┬
│＿│＿＿Ａ＿│＿＿Ｂ＿＿＿│＿＿Ｃ＿＿│＿＿Ｄ＿＿│＿＿Ｅ＿＿│
├─┼────┼──────┼─────┼─────┼─────┼
│１│頂点番号│＿＿Ｂ＿＿＿│＿Ｘ座標＿│＿Ｙ座標＿│＿回転角＿│
├─┼────┼──────┼─────┼─────┼─────┼
│２│＿ｐｓ１│頂点シンボル│＿＿＿＿０│＿＿＿＿０│＿＿＿＿０│
├─┼────┼──────┼─────┼─────┼─────┼
│３│＿ｐｓ２│頂点シンボル│＿＿１．２│＿１．４４│＿＿＿＿０│
├─┼────┼──────┼─────┼─────┼─────┼
│４│＿ｐｓ３│頂点シンボル│＿＿２．４│＿５．７６│＿＿＿＿０│
├─┼────┼──────┼─────┼─────┼─────┼
※回転角は、シンボルの回転角です。

2. F2〜G4セルに式を入れる。
セル:F2　="NameObject('" & A2 & "');"
セル:F3　="NameObject('" & A3 & "');"
セル:F4　="NameObject('" & A4 & "');"
セル:G2　="Symbol('" & B2 & "', " & C2 & ", " & D2 & ", "& E2 &");"
セル:G3　="Symbol('" & B3 & "', " & C3 & ", " & D3 & ", "& E3 &");"
セル:G4　="Symbol('" & B4 & "', " & C4 & ", " & D4 & ", "& E4 &");"

結果は下のようになります。
NameObject('ps1'); Symbol('頂点シンボル', 0, 0, 0);
NameObject('ps2'); Symbol('頂点シンボル', 1.2, 1.44, 0);
NameObject('ps3'); Symbol('頂点シンボル', 2.4, 5.76, 0);

以下省略。

多角形の頂点に基準点を描きます。（多角形は描きません）
ついでに基準点に名前も付けてみます。名前は「p1」、「p2」、「p3」とします。

1. 元のデータを用意する。
┌─┬────┬─────┬─────┬
│＿│＿＿Ａ＿│＿＿Ｂ＿＿│＿＿Ｃ＿＿│
├─┼────┼─────┼─────┼
│１│頂点番号│＿Ｘ座標＿│＿Ｙ座標＿│
├─┼────┼─────┼─────┼
│２│＿＿ｐ１│＿＿＿＿０│＿＿＿＿０│
├─┼────┼─────┼─────┼
│３│＿＿ｐ２│＿＿１．２│＿１．４４│
├─┼────┼─────┼─────┼
│４│＿＿ｐ３│＿＿２．４│＿５．７６│
├─┼────┼─────┼─────┼

2. D2〜E4セルに式を入れる。
セル:D2　="NameObject('" & A2 & "');"　セル:E2　="LoCus(" & B2 & ", " & C2 & ");"
セル:D3　="NameObject('" & A3 & "');"　セル:E3　="LoCus(" & B3 & ", " & C3 & ");"
セル:D4　="NameObject('" & A4 & "');"　セル:E4　="LoCus(" & B4 & ", " & C4 & ");"

'と"が紛らわしいので気を付けてください。（私もまちがえました）
VWでは文字列を'と'で囲み、Excelでは"と"で囲みます。
２行目をタイプしたら、３行目と４行目は２行目をコピペすればＯＫです。
D2〜E4の結果は下のようになります。
NameObj('p1'); Locus(0 , 0);
NameObj('p2'); Locus(1.2 , 1.44);
NameObj('p3'); Locus(2.4 , 5.76);

以下省略。

もうすこし使いまわしが利く方法を紹介します。VWのワークシートでは出来ない方法です。
今回は多角形を書くのに別の書式を使います。（以下）
BeginPoly;
AddPoly(Ｘ座標1, Ｙ座標1);
AddPoly(Ｘ座標2, Ｙ座標2);
.
.
.
AddPoly(Ｘ座標n, Ｙ座標n);
EndPoly;

1． 元データを用意する。
┌─┬─────┬─────┬
│＿│＿＿Ａ＿＿│＿＿Ｂ＿＿│
├─┼─────┼─────┼
│１│＿＿＿＿＿│＿＿＿＿＿│
├─┼─────┼─────┼
│２│＿Ｘ座標＿│＿Ｙ座標＿│
├─┼─────┼─────┼
│３│＿＿＿＿０│＿＿＿＿０│
├─┼─────┼─────┼
│４│＿＿１．２│＿１．４４│
├─┼─────┼─────┼
│５│＿＿２．４│＿５．７６│
├─┼─────┼─────┼

2. Ｃ列に式を打ち込む。
┌─┬─────┬─────┬───────────────────
│＿│＿＿Ａ＿＿│＿＿Ｂ＿＿│＿＿Ｃ＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
├─┼─────┼─────┼───────────────────
│１│＿＿＿＿＿│＿＿＿＿＿│ClosePoly;
├─┼─────┼─────┼───────────────────
│２│＿Ｘ座標＿│＿Ｙ座標＿│BeginPoly;
├─┼─────┼─────┼───────────────────
│３│＿＿＿＿０│＿＿＿＿０│="AddPoly(" & A3 & ", " & B3 & ");"
├─┼─────┼─────┼───────────────────
│４│＿＿１．２│＿１．４４│="AddPoly(" & A4 & ", " & B4 & ");"
├─┼─────┼─────┼───────────────────
│５│＿＿２．４│＿５．７６│="AddPoly(" & A4 & ", " & B4 & ");"
├─┼─────┼─────┼───────────────────
│６│＿＿＿＿＿│＿＿＿＿＿│EndPoly;
├─┼─────┼─────┼───────────────────

Ｃ列の表示は下のようになります。
ClosePoly;
BeginPoly;
AddPoly(0, 0);
AddPoly(1.2, 1.44);
AddPoly(2.4, 5.76);
EndPoly;


3. C1〜C6の範囲をテキストエディタにコピペして、テキストファイルとして保存する。
4. （VWの）「ファイル」−「取り込む」−「VectorScript...」で読み込む。（終わり）

AddPolyの行を変更（追加，削除）することで、別の多角形も簡単に作れます。

毎度まいどの削除依頼で申し訳ありませが、
「Excelでスクリプトを作る方法(2)」の削除をお願いします。
”と’を間違えてしまいました^^;）。

座標リストから多角形を作図するとき、数字をダイアログで打ち込むのは面倒ですが、
簡単なスクリプトで多角形を描かすことができます。
多角形を描くスクリプトは、
ClosePoly;
Poly(Ｘ座標1, Ｙ座標1, Ｘ座標2, Ｙ座標2...Ｘ座標n, Ｙ座標n);
の２行です。
１行目のClosePoly; は、これ以降の多角形を閉じるというコマンドです。OpenPoly;
なら閉じません。
２行目が多角形生成コマンドです。
やっぱり数字を打ち込むのかとか、一行に収まらないくらい長かったらどうするんだと
お思いでしょうが、VectorScriptはカンマやカッコの前後で改行できるので、
ClosePoly;
Poly(
Ｘ座標1, Ｙ座標1,
Ｘ座標2, Ｙ座標2,
.
.
.
Ｘ座標n, Ｙ座標n
);
のように書くことが出来ます。そして、この形式だとテキストエディタよりExcelを使っ
たほうがメリットがあります。（VWのワークシートでも可能ですが、Excelで作ったほう
が簡単です。）

例として、
1． はじめに、Excelに頂点の座標を打ち込みます。ダイアログやテキストエディタに打
ち込むより楽だと思います。データがあるならコピペで済みます。
┌─┬─────┬─────┬
│＿│＿＿Ａ＿＿│＿＿Ｂ＿＿│
├─┼─────┼─────┼
│１│＿Ｘ座標＿│＿Ｙ座標＿│
├─┼─────┼─────┼
│２│＿＿＿＿０│＿＿＿＿０│
├─┼─────┼─────┼
│３│＿＿１．２│＿１．４４│
├─┼─────┼─────┼
│４│＿＿２．４│＿５．７６│
├─┼─────┼─────┼
（※レイアウトの都合で全角文字にしていますが、実際は半角文字です。＿は無視して
ください）

2. コマンドやカンマを入れる為に、行と列を挿入して、下のように仕上げる。
┌─┬─────┬─┬────┬──┬
│＿│＿＿Ａ＿＿│Ｂ│＿Ｃ＿＿│Ｄ＿│
├─┼─────┼─┼────┼──┼
│１│ＣｌｏｓｅＰｏｌｙ；＿＿│＿＿│
├─┼─────┼─┼────┼──┼
│２│Ｐｏｌｙ（│＿│＿＿＿＿│＿＿│
├─┼─────┼─┼────┼──┼
│３│＿＿＿＿０│，│＿＿＿０│，＿│
├─┼─────┼─┼────┼──┼
│４│＿＿１．２│，│１．４４│，＿│
├─┼─────┼─┼────┼──┼
│５│＿＿２．４│，│５．７６│＿＿│
├─┼─────┼─┼────┼──┼
│６│）；＿＿＿│＿│＿＿＿＿│＿＿│
├─┼─────┼─┼────┼──┼

3. A1〜D6の範囲をコピーして、テキストエディタにペーストし、
4. テキストファイルとして保存する。
テキストファイルの内容は、下のようになっています。
ClosePoly;
Poly(
0 , 0,
1.2 , 1.44,
2.4 , 5.76
);

5. （VWの）「ファイル」−「取り込む」−「VectorScript...」で読み込む。
これで多角形が出来ているはずです。

面倒だと感じるかも知れませんが、頂点が多い場合はこちらのほうが楽だと思います。テ
キストファイルが残る点や、座標のチェックが容易なのも利点です。

もちろん、テキストファイルに保存したり、VWのワークシートに入力（またはコピペ）し
た座標データから多角形を生成するスクリプトを書く事もできます（私も含めて多くの人
が実際に作って使ってるいます）が、それなりの約束事があり、それがスクリプトを書く
上での最初のハードルになっています。
しかしこのような座標入力のついでに作ってしまえるスクリプトなら、ハードルもずいぶ
ん低くなる思いますが、どうでしょうか。

VW9からは「マクロ編集...」ボタンが「スクリプト編集...」ボタンに変わってますね。

登録画面で画面表示を切り替えると同時に、スクリプトを実行することが可能です。
たとえば、画面切り替えと同時に、座標原点やグリッドを変更したり、カラー表示／白黒
表示を切り替えたりできます。
登録画面で実行するスクリプトを作成するには、登録画面の編集ダイアログの「キャンセ
ル」ボタンの上の「マクロ編集...」ボタンをクリックします。
「マクロ編集...」ボタンは、登録画面作成時には現れません。一旦登録画面を作ってから、
リソースパレットかコマンドパレットから編集ダイアログを開くと、「マクロ編集...」ボ
タンが現れます。
注意する点は、使う側からはスクリプトの有無が判らないことです。（知らない人が使う
と、勝手に設定が変わるので、VWのバグだと思われかねないので、説明が必要です）

書き込みをバックナンバーに送りました。
よろしくお願いいたします。