VectorWorks Club北海道

2004年・Script談話室バックナンバー

パス図形に沿って、文字を均等配列にする 　 与太郎さんた
email:　 Wed Dec 22 18:21:56 2004

ちょっと早いクリスマスプレゼントです。
標準の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);

文字を回転するスクリプト 　 与太郎
email:　 Wed Dec 22 12:55:13 2004

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

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);

均等割付文字（グループ図形）を普通の文字にする（３） 　 与太郎
email:　 Tue Dec 21 21:25:40 2004

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

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

均等割付文字（グループ図形）を普通の文字にする（２） 　 与太郎
email:　 Tue Dec 21 8:09:25 2004

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

文字と基準線の間隔を調節する 　 与太郎
email:　 Mon Dec 20 21:50:23 2004

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

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);

Re:やってはいけない割り算？ 　 石男
email:　 Mon Dec 20 15:56:18 2004

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

Re:やってはいけない割り算？ 　 石男
email:　 Mon Dec 20 9:38:03 2004

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

Re:やってはいけない割り算？ 　 与太郎
email:　 Sun Dec 19 20:09:29 2004

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

＞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
という考え方でどうでしょうか？

均等割付文字（グループ図形）を普通の文字にする 　 与太郎
email:　 Sun Dec 19 19:54:51 2004

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

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);

やってはいけない割り算？ 　 石男
email:　 Sat Dec 18 10:04:27 2004

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

文字を均等配列にするスクリプト（改定版） 　 与太郎
email:　 Fri Dec 17 20:50:34 2004

構造体をやめたので、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);

文字の角度を設定するスクリプト 　 与太郎
email:　 Thu Dec 16 22:34:18 2004

文字を均等配列にするスクリプトと合わせて使えば、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);

Re: SetTextで文字列を設定するときの注意 　 陰陽師
email:　 Thu Dec 16 16:37:17 2004

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

Re: Text編集ダイアログ 　 石男
email:　 Thu Dec 16 14:10:49 2004

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

SetTextで文字列を設定するときの注意 　 与太郎
email:　 Thu Dec 16 13:06:49 2004

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

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

Re: Text編集ダイアログ 　 陰陽師
email:　 Thu Dec 16 11:37:19 2004

>石男さん

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

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

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

Re: Text編集ダイアログ 　 陰陽
email:　 Thu Dec 16 10:34:57 2004

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

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

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

Re.: Text編集ダイアログ 　 石男
email:　 Thu Dec 16 9:27:26 2004

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

Text編集ダイアログ 　 陰陽
email:　 Wed Dec 15 21:01:28 2004

こんばんわ陰陽師です。
石男さんに モダンダイアログの 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);

曲線の円弧半径を得るには 　 与太郎
email:　 Wed Dec 15 20:09:19 2004

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

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

Re4: 文字サイズを変えずに拡大/縮小するには？ 　 石男
email:　 Wed Dec 15 18:17:47 2004

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


Re3: 文字サイズを変えずに拡大/縮小するには？ 　 与太郎
email:　 Wed Dec 15 18:00:51 2004

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

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

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

めんどくさいですね。

文字を均等配列にする（２） 　 与太郎
email:　 Wed Dec 15 15:16:31 2004

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

Re.: 文字サイズを変えずに拡大/縮小するには？ 　 石男
email:　 Wed Dec 15 10:29:57 2004

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

Re.: 文字サイズを変えずに拡大/縮小するには？ 　 石男
email:　 Wed Dec 15 9:27:12 2004

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

文字サイズを変えずに拡大/縮小するには？ 　 与太郎
email:　 Tue Dec 14 20:56:08 2004

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

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

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

＞ARcoatingさん
おひさです！

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

Re.: Vector Script専用 Editor(for Win) 　 石男
email:　 Tue Dec 14 9:08:07 2004

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

感謝。 　A&B
email:　 Mon Dec 13 20:07:49 2004

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

Re^2:四角形の傾き 　 石男
email:　 Mon Dec 13 16:47:40 2004

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

Re:四角形の傾き 　 与太郎
email:　 Mon Dec 13 14:10:56 2004

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

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を使いました。
距離の比較に「=」は、まずいかも。（誤差を考慮しないと）

Vector Script専用 Editor(for Win) 　 陰陽師
email:　 Mon Dec 13 10:19:05 2004

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

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

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

四角形の傾き 　 石男
email:　 Mon Dec 13 9:16:07 2004

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

Re.:カメラのネタ 　 石男
email:　 Mon Dec 13 8:38:26 2004

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


re:カメラのネタ 　ARcoating
email:　 Sat Dec 11 19:20:17 2004

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

カメラのネタ 　 石男
email:　 Sat Dec 11 11:33:34 2004

>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 ) ;

ロジスティック方程式 　ARcoating
email:　 Fri Dec 10 22:24:28 2004

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

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


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);

文字を均等配列にする 　 与太郎
email:　 Fri Dec 10 19:46:11 2004

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

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);

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

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

名前をワークシートに書き出す。 　 与太郎
email:　 Sun Dec 5 22:01:20 2004

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

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は新しく名前が付けられたときのために空い
たままになるようです。

図面上の文字をワークシートにコピーする 　 与太郎
email:　 Fri Dec 3 22:31:51 2004

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

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);

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

螺旋形の3D多角形を作る。 　 与太郎
email:　 Mon Nov 29 22:50:38 2004

このスクリプトを作るには、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エディタが開きます。

クラスの線幅を設定する 　 与太郎
email:　 Sun Nov 28 22:00:37 2004

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

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);

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

クラスの線幅をワークシートに書き出す 　 与太郎
email:　 Sun Nov 28 21:53:09 2004

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);

スクリプトでレイヤを削除する。 　 与太郎
email:　 Thu Nov 25 20:28:30 2004

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

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);

レイヤ情報を取得して色々と... 　 与太郎
email:　 Wed Nov 24 22:42:15 2004

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

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から調べる方法はないですかね？

各レイヤの図形数を調べる(2) 　 与太郎
email:　 Mon Nov 22 22:02:10 2004

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

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);

各レイヤの図形数を調べる 　 与太郎
email:　 Sun Nov 21 21:23:41 2004

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

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はクラシック環境です。

Re^2:リソース編集 　 石男
email:　 Sat Nov 20 16:16:32 2004

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

Re:リソース編集 　 与太郎
email:　 Fri Nov 19 22:13:09 2004

＞リソース編集をみなさんは何を使っているのでしょうか？
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しますよ。

リソース編集 　 石男
email:　 Fri Nov 19 11:15:27 2004

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

Re7:マニュアルについて 　 与太郎
email:　 Sat Nov 13 16:41:36 2004

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

Re6:マニュアルについて 　 石男
email:　 Sat Nov 13 15:48:01 2004

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

Re2: JW取り出しについて 　 　 与太郎
email:　 Sat Nov 13 14:01:53 2004

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

Re5:マニュアルについて 　 与太郎
email:　 Sat Nov 13 13:56:22 2004

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

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

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

Re4:マニュアルについて 　 石男
email:　 Fri Nov 12 12:59:52 2004

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

Re.: JW取り出しについて 　 石男
email:　 Wed Nov 10 13:42:45 2004

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

JW取り出しについて 　fuku
email:　 Wed Nov 10 7:52:27 2004

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

Re3:マニュアルについて 　 与太郎
email:　 Tue Nov 2 22:53:08 2004

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

Re^2:マニュアルについて 　 石男
email:　 Mon Nov 1 18:28:46 2004

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

RE:マニュアルについて 　masafumi
email:　 Sun Oct 31 0:52:05 2004

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

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

マニュアルについて 　 与太郎
email:　 Sat Oct 30 20:48:19 2004

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

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

RE:タブ区切りファイルについて 　 与太郎
email:　 Thu Oct 14 22:28:36 2004

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

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

RE:タブ区切りファイルについて 　 石男
email:　 Thu Oct 14 18:16:25 2004

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

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

RE:タブ区切りファイルについて 　masafumi
email:　 Thu Oct 14 16:54:25 2004

下記は　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);

タブ区切りファイルについて 　 与太郎
email:　 Thu Oct 14 12:48:06 2004

性懲りもなく、タブ区切りファイルの 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表示かを調べる関数も。

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

Re6:イベント実行 　 石男
email:　 Fri Oct 8 12:34:05 2004

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

Re5:イベント実行 　masafumi
email:　 Thu Oct 7 23:30:34 2004

＞VWPluginLibraryRoutines.p

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

IsPolyClosed(polyHandle: HANDLE) : BOOLEAN;

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

Re4:イベント実行 　 与太郎
email:　 Thu Oct 7 22:34:39 2004

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

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

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

Re2:イベント実行 　 石男
email:　 Wed Oct 6 12:49:44 2004

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

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

Re2:イベント実行 　 与太郎
email:　 Tue Oct 5 18:12:27 2004

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

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

Re:イベント実行 　 与太郎
email:　 Fri Sep 24 21:58:49 2004

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

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

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

長文につき... 　 石男
email:　 Fri Sep 24 9:18:15 2004

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

イベント実行 　 石男
email:　 Fri Sep 24 9:13:16 2004

以下のものは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);



Re:スクリプトの中で線種選択メニューを使う 　 与太郎
email:　 Thu Sep 23 20:02:39 2004

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

スクリプトの中で線種選択メニューを使う 　 与太郎
email:　 Thu Sep 23 12:37:19 2004

メニューで線種を選択して、線種番号を返す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);

ポイント型のPIOにプッシュボタンを付ける方法 　 与太郎
email:　 Wed Sep 22 20:52:58 2004

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

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

Re:スクリプトの中でカラーパレットを使う 　 与太郎
email:　 Wed Sep 22 20:19:25 2004

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

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

Re.無題 　 石男
email:　 Wed Sep 22 8:37:34 2004

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

スクリプトの中でカラーパレットを使う 　 与太郎
email:　 Tue Sep 21 22:09:40 2004

とりあえず使う予定はないんですが、色を選択する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);

Re2: 無題 　 与太郎
email:　 Tue Sep 21 22:07:20 2004

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

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

Re: 無題 　 石男
email:　 Fri Sep 17 14:51:24 2004

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

無題 　 与太郎
email:　 Fri Sep 17 12:59:09 2004

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

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

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

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

HiBaseのことなど... 　 石男
email:　 Wed Sep 15 9:00:16 2004

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

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

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

Re8:レコード付き図形 　 与太郎
email:　 Tue Sep 14 18:50:21 2004

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

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

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

Re7:レコード付き図形 　 石男
email:　 Tue Sep 14 12:57:41 2004

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

Re6:レコード付き図形 　 与太郎
email:　 Mon Sep 13 19:13:06 2004

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

Re5:レコード付き図形 　 石男
email:　 Mon Sep 13 17:25:22 2004

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

Re4:レコード付き図形 　 与太郎
email:　 Mon Sep 13 13:54:07 2004

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

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)でハンドルを取ります。

Re3:レコード付き図形 　 石男
email:　 Mon Sep 13 12:32:31 2004

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

Re2:レコード付き図形 　 与太郎
email:　 Mon Sep 13 10:58:34 2004

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

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デモ版にて)

Re:レコード付き図形 　 与太郎
email:　 Mon Sep 13 10:18:53 2004

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

レコード付き図形 　 石男
email:　 Mon Sep 13 8:55:34 2004

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

Re3:重複グループを削除するスクリプト 　nao
email:　 Mon Sep 13 1:06:27 2004

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

Re2:重複グループを削除するスクリプト 　 与太郎
email:　 Sun Sep 12 15:40:28 2004

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

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

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

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

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

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

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

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

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

Re:重複グループを削除するスクリプト 　
email:　 Sun Sep 12 0:35:34 2004

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

数百個単位の図形なら同じ図形の重複は下のスクリプトのタイプの部分を変えることでほぼ対応出来る
のでしょうか？タイプによってデータが壊れるようなことはないのですか。スクリプトは全然わからず
メニューツールの選択/表示マクロ位しか使っていないのでよくわかりません。
VectorWorks 談話室より
>>