Scriptの66行目、
『AlrtDialog(Concat('A2セルは...』は、
『AlrtDialog(Concat('B1セルは...』の間違いです。
大変失礼いたしました。

与太郎さん、本当にありがとうございました！！
リファレンスなどを参照しつつ、こちらをよく理解してみていろいろといじってみて先
へ進んでゆきたいと思います！

年の瀬に大変ご迷惑をおかけいたしました。
ありがとうございました。

用意するもの
１）ワークシート
Ａ列：番号
Ｂ列：密度
２行目以降：データ

２）レコード
レコード名：ブロック（または現在付けてる名前）
フィールド１：番号 {タイプ = Integer}
フィールド２：密度 {タイプ = Number}

３）グループ図形（ブロック）
図形１：四角形
図形２：文字 {内容は何でも良い}

上のものが出来たら、グループ図形にレコードを割り当て、番号を設定。
最後にスクリプトで着色です。

RGBの設定が良く判らなかったので、とりあえずグレイスケールで着色しました。
階調を細かく表示するにはカラーパレットのカスタマイズが必要です。

procedure PaintGroups;
label
＿9999;
const
＿RecordName = 'ブロック';
＿Field1 = '番号';
＿Field2 = '密度';
＿ColumnTitle1 = '番号';
＿ColumnTitle2 = '密度';
＿MaxData = 100;{ 密度の最大値 }
＿RectObj = 3;
＿TextObj = 10;
＿SQ = Chr(39); {'}
var
＿criteria, nm, s, msg＿:string;
＿hWS＿:handle;
＿nRow, nClm, rw, c＿:integer;
＿data＿:real;
＿
＿procedure DoGroupObj(hG:handle);
＿var
＿＿hR, hT＿:handle;
＿＿scl＿:longint;
＿＿
＿＿procedure AddMessage;
＿＿begin
＿＿＿if msg = '' then
＿＿＿＿msg:= nm
＿＿＿else
＿＿＿＿msg:= Concat(msg, ', ', nm);
＿＿end;{AddMessage}
＿＿
＿begin{DoGroupObj}
＿＿hR:= FInGroup(hG);
＿＿if (hR <> nil) & (GetType(hR) = RectObj) then begin
＿＿＿hT:= NextObj(hR);
＿＿＿if (hT <> nil) & (GetType(hT) = TextObj) then begin
＿＿＿＿SetRField(hG, RecordName, Field2, Concat(data));
＿＿＿＿SetText(hT, Concat(' ', nm, ' '));
＿＿＿＿scl:= 65536 - Round(65536 * data / MaxData);
＿＿＿＿SetFPat(hR, 2);
＿＿＿＿SetFillFore(hR, scl, scl, scl);
＿＿＿＿SetFillBack(hR, scl, scl, scl);
＿＿＿end
＿＿＿else
＿＿＿＿AddMessage;
＿＿end
＿＿else
＿＿＿AddMessage;
＿end;{DoGroupObj}
＿
begin{main}
＿hWS:= ActSSheet;
＿if hWS = nil then begin
＿＿AlrtDialog('アクティブなワークシートがありません。');
＿＿GoTo 9999;
＿end;
＿GetWSRowColumnCount(hWS, nRow, nClm);
＿GetWSCellString(hWS, 1, 1, s);
＿if s <> ColumnTitle1 then begin
＿＿AlrtDialog(Concat('A1セルは「', ColumnTitle1, '」でないと無効です。'));
＿＿GoTo 9999;
＿end;
＿GetWSCellString(hWS, 1, 2, s);
＿if s <> ColumnTitle2 then begin
＿＿AlrtDialog(Concat('A2セルは「', ColumnTitle2, '」でないと無効です。'));
＿＿GoTo 9999;
＿end;
＿msg:= '';
＿for rw:= 2 to nRow do begin
＿＿GetWSCellString(hWS, rw, 1, nm);
＿＿criteria:= Concat('((', SQ, RecordName, SQ, '.', SQ, Field1, SQ, '=', nm, ')&(T=GROUP))');
＿＿c:= Count(criteria);
＿＿if c = 0 then begin
＿＿＿AlrtDialog(Concat('番号「', nm, '」のブロックがありません。'));
＿＿＿GoTo 9999;
＿＿end;
＿＿DSelectAll;
＿＿SelectObj(criteria);
＿＿if c > 1 then begin
＿＿＿AlrtDialog(Concat('番号「', nm, '」のブロックが２個以上あります。'));
＿＿＿GoTo 9999;
＿＿end;
＿＿GetWSCellString(hWS, rw, 2, s);
＿＿data:= Str2Num(s);
＿＿ForEachObject(DoGroupObj, criteria);
＿end;
＿if msg <> '' then
＿＿Message(msg, '番のグループ図形が不正です。');
9999:
end;{PaintGroups}
Run(PaintGroups);

与太郎さん、お返事ありがとうございます！！
とりあえず最初はシミュレーションは先のことと考えて、まずはエクセルデータと照らし
合わせて色分けをしたいと考えております。密度はこちらのデータで作成中です。
つまりは
＞７）ワークシートの読み書き。
ということになってくるでしょうか？

しかし
＞６）図形に付けた名前やレコードなど様々な検索条件で特定の図形にアクセスし、図形を移動、変形、削除したり、図形情報、属性、レコードを読み書きする。
を考えますと、現在レコードを利用してブロック番号を与えているのでこちらにそれぞれ
のブロックにエクセルデータによる数値を与えるのが妥当なのでしょうかね。

ワークシート(エクセルデータ)とレコード番号をリンクさせて色分けという事は可能で
すか？6)と7)の融合です。
例えば５番ブロックは密度が高いので濃い赤で、７番ブロックは密度が低いので薄い赤と
するとか…
ブロック数が多いゆえ、6)と7)が融合できたら一番なのですが…

本当にこんな時期に申し訳ありませんが、事例などありましたらご教授ください。

動線行動モデルはよくわからないですが、ブロックの色分けは簡単に出来ます。
パラメータをブロック自身に（レコードとして）持たせるか、ワークシートで設定するかでやり方は違います。
密度は人数／ブロック面積でいいのでしょうか？

スクリプトで出来ること
１）図形の作成。
２）画面表示（レイヤ設定、クラス設定、表示範囲、視点、視線方向）の変更。
３）作図環境（デフォルト属性、ツール選択）の変更。
４）環境設定の変更。
５）メニューコマンドの実行。
６）図形に付けた名前やレコードなど様々な検索条件で特定の図形にアクセスし、図形を移動、変形、削除したり、図形情報、属性、レコードを読み書きする。
７）ワークシートの読み書き。
８）テキストファイルの読み書き。
９）VWで未定義の新しいタイプの図形オブジェクトの作成。
10）上記機能を利用したメニューコマンドやツールコマンドの作成。

上のように、素のVWで出来るほとんどの事と、それ以上の事がスクリプトで出来ます。

＞最終的には各ブロックに行きやすさや視認性など様々なパラメーターを入れて簡単な
＞シミュレーションを行えたらと考えているのですが、そこまで行うことは可能でしょう
＞か？
他のプログラミング環境で実現可能な問題なら、スクリプトでも大丈夫でしょう。
インターフェース作成の手間を考えたら、VW＋スクリプトのほうが楽だと思います。

初めての書き込みです。稚拙な質問かもしれませんがよろしくお願いいたします。

動線行動モデル作成を考えているのですが。。。
ある平面図(まだ変更の可能性あり)がありまして、それを廊下や部屋などとある程度
ブロック分けしてとりあえず四角ツールで番号を振ってゆきました。
そのブロックごとに、人の密度状況を色分けしてゆきたいのですが、scriptを利用すれば
このようなことは簡単に可能でしょうか？
また一度も利用したことがないので何かこのような参考例等がもしありましたら教えて
いただけると幸いです。

最終的には各ブロックに行きやすさや視認性など様々なパラメーターを入れて簡単な
シミュレーションを行えたらと考えているのですが、そこまで行うことは可能でしょう
か？

Procedure PlotArea;
CONST
n=2; {小数点以下の必要な桁数。これより下を四捨五入します。}
tsize=18; {フォントサイズ}
Yoffset=-360; {中心から下へのズレ。通常、図形の中心には室名があることが多いので...。}
fontnuber=204;{フォントが何番目かを入れます。}
VAR
h:HANDLE;
x1,y1,Temp:REAL;
Str1,Str2:STRING;
BEGIN
h:=FSActLayer;
IF h<>NIL THEN
BEGIN
PushAttrs;
WHILE h<>NIL DO
BEGIN
Temp:=HArea(h) /10^6;
Str1:=Concat(Num2Str(n,Temp),' m2');
Str2:=Concat('(',Num2Str(n,Temp/1.82^2),' 坪',')');

HCenter(h,x1,y1);
TextOrigin(x1,y1+Yoffset);
Textfont(fontnuber);
TextSize(tsize);
TextJust(2);
TextVerticalAlign(3);
NameClass('AreaText');
BeginText;
Str1
EndText;
SetDSelect(LNewObj);

TextOrigin(x1,y1+Yoffset-HHeight(LNewObj));
NameClass('AreaText-tubo');
BeginText;
Str2
EndText;
SetDSelect(LNewObj);
h:=NextSObj(h);
END;
PopAttrs;
END;
END;
RUN(PlotArea);

#CVAL?だけでは式が正しくないことしか判りません...

ワークシートで#CVAL?と表示されています。
いろいろ試しましたが解決する方法がわかりません。
どなたかお知恵を拝借お願い致します。

寸法文字の水平方向の位置を変えるには、
SetObjectVariableBoolean(h, 29, false); { 文字自動位置を解除 }
SetObjectVariableReal(h, 44, 0.25); { 文字の位置を左側から1/4の位置にする。 }
ResetObject(h);
のようにします。
文字自動位置が有効だと、数字を変えても文字の位置は変わりません。
また、ResetObjectを実行するまで寸法図形は更新されません。

文字の水平方向位置のパラメータには以下の３パターンがあります。
(1) ０以下：文字の位置は寸法線の左側。　寸法文字→|―|←
(2) ０〜１：文字の位置は寸法線の内側。　|←寸法文字→|
(3) ０以上：文字の位置は寸法線の右側。　→|―|←寸法文字

(1)と(3)は実際の長さですが、(2)は寸法線上での割合を示します。0.5なら真ん中です。
(2)と(3)で０〜１の間が重複しているので、設定方法は単純ではありません。
パラメータに０〜１を設定した場合、そのときの文字の位置によって結果が異なります。
文字が寸法線の内側にあるときは変更後にも文字は寸法線の内側に留まり、
右側にあるときは変更後にも文字は寸法線の右側になります。
というわけで、変更前の位置に関係なく文字の位置を設定するには、次の３パターンで行ないます。

左側：
SetObjectVariableReal(h, 44, -loc); { locには０以下の値を設定 }
ResetObject(h);
ReDrawAll;

内側：
SetObjectVariableReal(h, 44, 0.5); { ０〜１の間の値を設定 }
SetObjectVariableBoolean(h, 29, True); { 文字自動位置を有効にする }
ResetObject(h);
SetObjectVariableBoolean(h, 29, false); { 文字自動位置を無効にする }
SetObjectVariableReal(h, 44, loc); { locには０〜１の間の値を設定 }
ResetObject(h);

右側：
SetObjectVariableReal(h, 44, 2.0); { ０〜１以外の値を設定 }
ResetObject(h);
SetObjectVariableReal(h, 44, loc); { locには０以上の値を設定 }
ResetObject(h);
ReDrawAll;

はじめまして。
lienardimの設定でお聞きしたいことがあるのですが
寸法値をずらして表示させるにはどうすればよいのでしょうか。
また、寸法値の任意の値でオフセットさせるにはどうすればよいのでしょうか。

例えば、下記のような場合のやり方について教えてください。
lineardim(X+100,Y,X+100,Y+H+20,150,1,769,259,1);

管理人さん、
申し訳ありませんが、重複書き込みを削除してくださいませ。

ワークシートにブロックの高さを入れればいいと思います。セルをひとつのブロックに見立てるわけです。
１行目と１列目にはブロックの幅を入れればいいでしょう。

大学でベクタースクリプトを使ってボリュームスタディーの勉強をしている者です。D/Hを変数として、建物と建物の間を通ったときにどのような景観になるかを実験したいのですが、プログラム例を幾つか見せていただけませんでしょうか？



Procedure var4;

var
item: Integer;
ret: boolean;
AreaX, AreaY, Maxhight, unitX, unitY, MaxA, MaxV, DH: Real;
i, j, k, l, hight, kenpei, youseki, gaiku, D: Integer;
cntX, cntY, cntZ: Longint;

begin
AreaX := 130000;
AreaY := 260000;
Maxhight := 40000;

BeginDialog(1, 1, 10, 10, 150 ,480);
AddButton('OK', 1, 1, 20, 440, 90, 460);
AddField('20000', 2, 2, 20, 40, 70, 60);
AddField('mm', 3, 1, 70, 40, 90, 60);
AddField('x', 4, 1, 20, 15, 100, 35);
AddField('10000', 5, 2, 20, 100, 70, 120);
AddField('mm', 6, 1, 70, 100, 90, 120);
AddField('y', 7, 1, 20, 75, 100, 95);
AddField('4000', 8, 2, 20, 160, 70, 180);
AddField('mm', 9, 1, 70, 160, 90, 180);
AddField('hight', 10, 1, 20, 135, 100, 155);
AddField('80', 11, 2, 20, 220, 70, 240);
AddField('%', 12, 1, 70, 220, 90, 240);
AddField('建蔽率', 13, 1, 20, 195, 100, 215);
AddField('400', 14, 2, 20, 280, 70, 300);
AddField('%', 15, 1, 70, 280, 90, 300);
AddField('容積率', 16, 1, 20, 255, 100, 275);
AddField('1', 17, 2, 20, 340, 70, 360);
AddField('個', 18, 1, 70, 340, 90, 360);
AddField('街区数', 19, 1, 20, 315, 100, 335);
AddField('4000', 20, 2, 20, 400, 70, 420);
AddField('mm', 21, 1, 70, 400, 90, 420);
AddField('道路幅', 22, 1, 20, 375, 100, 395);
EndDialog;
GetDialog(1);
repeat
DialogEvent(item);
until (item = 1);

ret := ValidNumStr(GetField(2), unitX);
ret := ValidNumStr(GetField(5), unitY);
ret := ValidNumStr(GetField(8), hight);
ret := ValidNumStr(GetField(11), kenpei);
ret := ValidNumStr(GetField(14), youseki);
ret := ValidNumStr(GetField(17), gaiku);
ret := ValidNumStr(GetField(20), D);

ClrDialog;

MaxA := AreaX*(AreaY)*kenpei/100/gaiku;
MaxV := AreaX*(AreaY)*youseki/100/gaiku;
cntX := Trunc(AreaX/unitX);
cntY := Trunc(MaxA/(cntX * unitX)/unitY);
cntZ := Trunc(MaxV/(cntX * unitX)/(cntY * unitY));

begin
for l := 0 to gaiku - 1 do
begin
for i := 0 to cntZ - 1 do
begin
for j := 0 to cntY - 1 do
begin
for k := 0 to cntX - 1 do
begin
BeginXtrd(hight * i, (i + 1) * hight);
Rect(k * unitX, j * unitY + (D + cntY * unitY) * l, (k + 1) * unitX, (j + 1) * unitY + (D + cntY * unitY) * l);
EndXtrd;
end;
end;
end;
end;
end;
end;
Run(var4);

じゅじゅさん、こんにちは。

グループ図形の大きさはGetBBoxで判ります。
FInGroupはVW11でも無くなっていません。
ヘルプメニューかVWフォルダから「VectorScript Reference」を開いて、調べてみてください。

はじめまして。
始めたばかりで分からないことが多いので初歩的な質問で申し訳ありません。
VectorScriptを使って、グループにした図形の輪郭図形の座標をとりたいのですが、グループの座標をGet2DPtを使ってとると、グループの中心座標しかとることができません。
また、「MiniCADプログラミング入門」のReferenceに出ているFInGroupという関数を使ってみようと思ったのですが、この関数（それに類する関数）も見あたりません。
FInGroupの説明は、“ハンドルが指すグループの中で最上位の図形のハンドルを返します。”とあるのですが、現在これに類する関数はあるのでしょうか。

なお、今私が使っているVectorWorksのバージョンは１１です。

どなたかよいアドバイスを頂けないでしょうか。

今回は、断面になる図形と柱状体か3Dパス図形（E）を選択して実行して、断面を置き換えます。
断面には、四角形、長円、多角形、円／円弧、角丸四角形、曲線が使えます。グループは解除し
てください。
VWでは柱状体の断面には直線も使えますが、3Dパス図形（E）の断面には直線を使えません。簡単
にするためにこのスクリプトでは直線を無視しています。
また、元の断面が複数である可能性もあり、その場合どの図形の属性を使うか判断できないため、
元の断面の属性を保持するようにはしていません。

procedure test3;
{ 柱状体と3Dパス図形（E）の断面を別の図形に置き換える }
{ アクティブ・レイヤの柱状体か3Dパス図形（E）と、断面図形を選択して実行する。 }
{$ DEBUG}
label
＿＿999;
const
＿＿LF = Chr(13);
＿＿SQ = Chr(39); {'}
＿＿RectObj = 3;
＿＿OvalObj = 4;
＿＿PolyObj = 5;
＿＿ArcObj = 6;
＿＿RRectObj = 13;
＿＿CurveObj = 21;
＿＿
type
＿＿section = structure
＿＿＿＿h＿＿:handle;
＿＿＿＿x1, y1, x2, y2＿＿:real;
＿＿end;{section}
var
＿＿criteria, lName＿＿:string;
＿＿cnt1, cnt2, nSec＿＿:integer;
＿＿sec＿＿:dynArray[] of section;
＿＿dX, dY, xC, yC＿＿:real;
＿＿
＿＿function GetSections:integer;
＿＿var＿＿
＿＿＿＿h＿＿:handle;
＿＿＿＿i, n, tp＿＿:integer;
＿＿＿＿x1, y1, x2, y2＿＿:real;
＿＿begin
＿＿＿＿n:= 0;
＿＿＿＿h:= FSActLayer;
＿＿＿＿while h <> nil do begin
＿＿＿＿＿＿tp:= GetType(h);
＿＿＿＿＿＿case tp of
＿＿＿＿＿＿＿＿RectObj, OvalObj, PolyObj, ArcObj, RRectObj, CurveObj: begin
＿＿＿＿＿＿＿＿＿＿n:= n + 1;
＿＿＿＿＿＿＿＿end;
＿＿＿＿＿＿end;{case}
＿＿＿＿＿＿h:= NextSObj(h);
＿＿＿＿end;{while}
＿＿＿＿if 0 < n then begin
＿＿＿＿＿＿Allocate sec[1..n];
＿＿＿＿＿＿i:= 0;
＿＿＿＿＿＿h:= FSActLayer;
＿＿＿＿＿＿while h <> nil do begin
＿＿＿＿＿＿＿＿tp:= GetType(h);
＿＿＿＿＿＿＿＿case tp of
＿＿＿＿＿＿＿＿＿＿RectObj, OvalObj, PolyObj, ArcObj, RRectObj, CurveObj: begin
＿＿＿＿＿＿＿＿＿＿＿＿i:= i + 1;
＿＿＿＿＿＿＿＿＿＿＿＿sec[i].h:= h;
＿＿＿＿＿＿＿＿＿＿＿＿GetBBox(h, sec[i].x1, sec[i].y1, sec[i].x2, sec[i].y2);
＿＿＿＿＿＿＿＿＿＿end;
＿＿＿＿＿＿＿＿end;{case}
＿＿＿＿＿＿＿＿h:= NextSObj(h);
＿＿＿＿＿＿end;{while}
＿＿＿＿＿＿GetBBox(sec[1].h, x1, y1, x2, y2);
＿＿＿＿＿＿if 1 < n then begin
＿＿＿＿＿＿＿＿for i:= 2 to n do begin
＿＿＿＿＿＿＿＿＿＿UnionRect(x1, y1, x2, y2, sec[i].x1, sec[i].y1, sec[i].x2, sec[i].y2, x1, y1, x2, y2);
＿＿＿＿＿＿＿＿end;
＿＿＿＿＿＿end;{if}
＿＿＿＿＿＿dX:= -(x1 + x2) / 2;
＿＿＿＿＿＿dY:= -(y1 + y2) / 2;
＿＿＿＿end;{if}
＿＿＿＿GetSections:= n;
＿＿end;{GetSections}
＿＿
＿＿procedure DoPath3D(hP:handle);
＿＿var
＿＿＿＿h, hG, hD＿＿:handle;
＿＿＿＿i＿＿:integer;
＿＿＿＿result＿＿:boolean;
＿＿begin
＿＿＿＿hG:= NextObj(FInGroup(hP));
＿＿＿＿h:= FInGroup(hG);
＿＿＿＿while h <> nil do begin
＿＿＿＿＿＿hD:= h;
＿＿＿＿＿＿h:= NextObj(h);
＿＿＿＿＿＿DelObject(hD);
＿＿＿＿end;{while}
＿＿＿＿for i:= 1 to nSec do begin
＿＿＿＿＿＿h:= HDuplicate(sec[i].h, dX-xC, dY-yC);
＿＿＿＿＿＿result:= SetParent(h, hG);
＿＿＿＿end;{for}
＿＿＿＿ResetObject(hP);
＿＿＿＿cnt1:= cnt1 + 1;
＿＿end;{DoPath3D}
＿＿
＿＿procedure DoExtrude(hP:handle);
＿＿var
＿＿＿＿h, hD＿＿:handle;
＿＿＿＿i＿＿:integer;
＿＿＿＿result＿＿:boolean;
＿＿＿＿x1, y1, x2, y2＿＿:real;
＿＿＿＿x01, y01, x02, y02＿＿:real;
＿＿＿＿x, y＿＿:real;
＿＿begin
＿＿＿＿i:= 0;
＿＿＿＿h:= FInGroup(hP);
＿＿＿＿while h <> nil do begin
＿＿＿＿＿＿i:= i + 1;
＿＿＿＿＿＿hD:= h;
＿＿＿＿＿＿if i = 1 then begin
＿＿＿＿＿＿＿＿GetBBox(h, x01, y01, x02, y02);
＿＿＿＿＿＿end{if}
＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿GetBBox(h, x1, y1, x2, y2);
＿＿＿＿＿＿＿＿UnionRect(x01, y01, x02, y02, x1, y1, x2, y2, x01, y01, x02, y02);
＿＿＿＿＿＿end;{else}
＿＿＿＿＿＿h:= NextObj(h);
＿＿＿＿＿＿DelObject(hD);
＿＿＿＿end;{while}
＿＿＿＿x:= (x01 + x02) / 2;
＿＿＿＿y:= (y01 + y02) / 2;
＿＿＿＿for i:= 1 to nSec do begin
＿＿＿＿＿＿h:= HDuplicate(sec[i].h, x+dX, y+dY);
＿＿＿＿＿＿result:= SetParent(h, hP);
＿＿＿＿end;{for}
＿＿＿＿ResetObject(hP);
＿＿＿＿cnt2:= cnt2 + 1;
＿＿end;{DoExtrude}
＿＿
begin{main}
＿＿GetOrigin(xC, yC);
＿＿nSec:= GetSections;
＿＿if nSec = 0 then begin
＿＿＿＿AlrtDialog('断面図形が選択されていません！');
＿＿＿＿GoTo 999;
＿＿end;
＿＿lName:= GetLName(ActLayer);
＿＿cnt1:= 0;
＿＿criteria:= Concat('(L=',SQ, lName, SQ, ')&(SEL=TRUE)&(T=PLUGINOBJECT)&(R IN [', SQ, '3Dパス図形（E）', SQ, '])');
＿＿ForEachObject(DoPath3D, criteria);
＿＿cnt2:= 0;
＿＿criteria:= Concat('(L=',SQ, lName, SQ, ')&(SEL=TRUE)&(T=XTRD)');
＿＿ForEachObject(DoExtrude, criteria);
＿＿AlrtDialog(Concat(cnt1, '個の3Dパス図形（E）と、', LF, cnt2, '個の柱状体の断面を変更しました。'));
999:
end;
Run(test3);

今度は3Dパス図形（E）の断面を円から四角形に変えてみます。

3Dパス図形（E）はプラグイン・オブジェクトなので、検索条件は図形タイプとレコード名になります。
普通はレコード名はプラグイン・オブジェクトの名前と同じです。

FInGroupで3Dパス図形（E）の中に入ると、先頭に２つのグループ図形があります。
１番目は3Dパスのグループで、２番目が断面のグループです。
断面図形にアクセスするには２番目のグループに入ります。

procedure test2;
{ アクティブ・レイヤの円柱(3Dパス図形（E）)を角柱に変換する }
{$ DEBUG}
const
＿＿SQ = Chr(39); {'}
＿＿OvalObj = 4;
＿＿ArcObj = 6;
var
＿＿criteria, lName＿＿:string;
＿＿cnt＿＿:integer;
＿＿
＿＿procedure DoPath3D(hP:handle);
＿＿var
＿＿＿＿hG, hC, hR＿＿:handle;
＿＿＿＿x1, y1, x2, y2＿＿:real;
＿＿＿＿cls＿＿:string;
＿＿＿＿fPat, pPat, pWd＿＿:integer;
＿＿＿＿r, g, b＿＿:longint;
＿＿begin
＿＿＿＿hG:= NextObj(FInGroup(hP));
＿＿＿＿hC:= FInGroup(hG);
＿＿＿＿if (GetType(hC) = OvalObj) | (GetType(hC) = ArcObj) then begin
＿＿＿＿＿＿GetBBox(hC, x1, y1, x2, y2);
＿＿＿＿＿＿Rect(x1, y1, x2, y2);
＿＿＿＿＿＿hR:= LNewObj;
＿＿＿＿＿＿if SetParent(hR, hG) then begin
＿＿＿＿＿＿＿＿cls:= GetClass(hC); SetClass(hR, cls);
＿＿＿＿＿＿＿＿fPat:= GetFPat(hC); SetFPat(hR, fPat);
＿＿＿＿＿＿＿＿pPat:= GetLS(hC); SetLS(hR, pPat);
＿＿＿＿＿＿＿＿pWd:= GetLW(hC); SetLW(hR, pWd);
＿＿＿＿＿＿＿＿GetFillFore(hC, r, g, b); SetFillFore(hR, r, g, b);
＿＿＿＿＿＿＿＿GetFillBack(hC, r, g, b); SetFillBack(hR, r, g, b);
＿＿＿＿＿＿＿＿GetPenFore(hC, r, g, b); SetPenFore(hR, r, g, b);
＿＿＿＿＿＿＿＿GetPenBack(hC, r, g, b); SetPenBack(hR, r, g, b);
＿＿＿＿＿＿＿＿DelObject(hC);
＿＿＿＿＿＿＿＿cnt:= cnt + 1;
＿＿＿＿＿＿end{if}
＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿DelObject(hR);
＿＿＿＿＿＿end;{else}
＿＿＿＿ResetObject(hP);
＿＿＿＿end;{if}
＿＿end;{DoPath3D}
＿＿
begin{main}
＿＿lName:= GetLName(ActLayer);
＿＿criteria:= Concat('(L=',SQ, lName, SQ, ')&(T=PLUGINOBJECT)&(R IN [', SQ, '3Dパス図形（E）', SQ, '])');
＿＿cnt:= 0;
＿＿ForEachObject(DoPath3D, criteria);
＿＿AlrtDialog(Concat(cnt, '個の円柱を角柱に変更しました。'));
end;
Run(test2);

円柱(柱状体)を角柱に変更するスクリプトです。

procedure test;
{ アクティブ・レイヤの円柱(柱状体)を角柱に変換する }
{$ DEBUG}
const
SQ = Chr(39); {'}
OvalObj = 4;
ArcObj = 6;
var
criteria, lName:string;
cnt:integer;

procedure DoExtrude(hE:handle);
var
hC, hR:handle;
x1, y1, x2, y2:real;
cls:string;
fPat, pPat, pWd:integer;
r, g, b:longint;
begin
hC:= FIn3D(hE);
if (GetType(hC) = OvalObj) | (GetType(hC) = ArcObj) then begin
GetBBox(hC, x1, y1, x2, y2);
Rect(x1, y1, x2, y2);
hR:= LNewObj;
if SetParent(hR, hE) then begin
cls:= GetClass(hC); SetClass(hR, cls);
fPat:= GetFPat(hC); SetFPat(hR, fPat);
pPat:= GetLS(hC); SetLS(hR, pPat);
pWd:= GetLW(hC); SetLW(hR, pWd);
GetFillFore(hC, r, g, b); SetFillFore(hR, r, g, b);
GetFillBack(hC, r, g, b); SetFillBack(hR, r, g, b);
GetPenFore(hC, r, g, b); SetPenFore(hR, r, g, b);
GetPenBack(hC, r, g, b); SetPenBack(hR, r, g, b);
DelObject(hC);
cnt:= cnt + 1;
end{if}
else begin
DelObject(hR);
end;{else}
end;{if}
end;{DoExtrude}

begin{main}
lName:= GetLName(ActLayer);
criteria:= Concat('(L=',SQ, lName, SQ, ')&(T=XTRD)');
cnt:= 0;
ForEachObject(DoExtrude, criteria);
AlrtDialog(Concat(cnt, '個の円柱を角柱に変更しました。'));
end;
Run(test);

＞VectorScript単独では無理です。
と与太郎さんが言えば間違いないところでしょう...。となるとMacならAppleScriptとの組
み合わせで可能です。
＞AppleScriptはほんの少し対応
でも結構なんとかなるものですよ、まあ面倒といえば面倒ですが。それとフォーサイト社から出ている「UI Browser」を使えば、ダイアログなんかも自動化できます。たとえば、このボタンをクリックした後にOKをクリックということをプログラム化できます。
基本的には誰もやったことのないことでしょうから、トライアンドエラーですが。
＞VBAの実装が実現すれば
これは数年前に社長にお願いしたのですが、そのままですね。

最近はとんとご無沙汰で...。

やっぱり、そうなんですよね。
たしか、AppleScriptはほんの少し対応してるだけだし、そもそもWindowsでは使えない。
せめて、AppleScriptの完全対応とか、VBAの実装が実現すれば、もっと世界が広がるんですけどね。

ExcelやAdobe系ソフトでは最上位のオブジェクトが "アプリケーション自身" になってるわけですが、
VectorWorksにもそういう仕様が必要かもしれませんね。

VectorScript単独では無理です。
タイムスタンプの更新なら、AppleScriptでファイルを開いてスクリプトを実行させれば出来るよう
な気がします。（想像に過ぎませんが）
印刷やファイル書き出しはダイアログが出ちゃうので、モニタの前でボタンを押す人が必要です。
Quickeyというソフトでボタンを自動的に押せるみたいだけど、今は日本で売ってないみたいです。
Winなら似たようなソフトがあるかも知れません。

VectorScriptって、複数ファイルを扱うスクリプトは書けないですよね？
たとえば、あるフォルダに入ってる100ヶの図面のタイムスタンプを一気に更新するとか、
全部を一発で下位バージョンに書き出すとか、プリントするとかです。

できるかできないかだけでも、はっきりわかる方いらっしゃいませんか？

動作確認です。すみません…m(^_^;)m

一番上で定義してるClosed関数は使ってないので、消しちゃって構いません。
VW8やVW9で動かそうとしたときの名残りです。

角錐を展開するスクリプトです。
面図形１個と基準点１個からなる多段柱状体を選択して、実行してください。
裏表の判断はしていません。

procedure ExpandPyramid;
{ 角錐を展開する（底面は曲線でも可） }
{ VW10以降に対応 }
{$ DEBUG}
label
＿999;
const
＿LF = Chr(13);
＿RectObj = 3;
＿OvalObj = 4;
＿PolyObj = 5;
＿ArcObj = 6;
＿RRectObj = 13;
＿LocusObj = 17;
＿CurveObj = 21;
＿MultiExtrdObj = 38;
var
＿result＿:boolean;
＿h, hC, hL, hP, hD, hTr＿:handle;
＿i, n, dv, oldDv＿:integer;
＿x0, y0, xC, yC＿:real;
＿d＿:real;
＿ang, rot＿:real;
＿ht, wd, depth＿:real;
＿v＿:dynArray[] of vector;
＿p＿:dynArray[] of point;
＿lng＿:dynArray[] of 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 GetLocObjIn3D(h3D:handle; tp:integer):handle;
＿{ 3Dコンテナ内の基準点を返す }
＿var
＿＿h＿:handle;
＿begin
＿＿h:= FIn3D(h3D);
＿＿while (h <> nil) & (GetType(h) <> tp) do
＿＿＿h:= NextObj(h);
＿＿GetLocObjIn3D:= h;
＿end;{GetLocObjIn3D}
＿
＿function Get2DObjIn3D(h3D:handle):handle;
＿{ 3Dコンテナ内の面図形を返す }
＿var
＿＿result, h＿:handle;
＿begin
＿＿result:= nil;
＿＿h:= FIn3D(h3D);
＿＿while (h <> nil) & (result = nil) do begin
＿＿＿case GetType(h) of
＿＿＿＿RectObj, OvalObj, PolyObj, ArcObj, RRectObj, CurveObj: result:= h;
＿＿＿end;
＿＿＿h:= NextObj(h);
＿＿end;
＿＿Get2DObjIn3D:= result;
＿end;{Get2DObjIn3D}
＿
＿function TriDists2Ang(d0, d1, d2:real):real;
＿{ 三角形の３辺の長さから角度を返す。 }
＿begin
＿＿TriDists2Ang:= ArcCos((d1^2 + d2^2 - d0^2)/(2*d1*d2));{ 余弦定理による }
＿end;{TriDists2Ang}
＿
＿function Distance3D(x1, y1, z1, x2, y2, z2:real):real;
＿{ ２点間の距離(3D)を返す。 }
＿var
＿＿dx, dy, dz＿:real;
＿begin
＿＿dx:= x2 - x1; dy:= y2 - y1; dz:= z2 - z1;
＿＿Distance3D:= Sqrt(dx*dx + dy*dy + dz*dz);
＿end;{Distance3D}
＿
begin{main}
＿h:= LSActLayer;
＿if (h = nil) | (GetType(h) <> MultiExtrdObj) then begin
＿＿AlrtDialog('多段柱状体（角錐）を選択してください。'); GoTo 999;
＿end;
＿hL:= GetLocObjIn3D(h, LocusObj);
＿if hL = nil then begin
＿＿AlrtDialog('角錐ではありません（頂点がない）。'); GoTo 999;
＿end;
＿hC:= Get2DObjIn3D(h);
＿if hC = nil then begin
＿＿AlrtDialog('角錐ではありません（底面がない）。'); GoTo 999;
＿end;
＿GetVCenter(x0, y0);
＿oldDv:= GetPrefInt(55) div 2;
＿dv:= IntDialog(Concat('円周の分割数は？', LF, '(2, 4, 8, 18, 32, 64, 128, 256)'), Concat(oldDv));
＿hP:= HDuplicate(hC, 0, 0);
＿result:= SetParent(hP, ActLayer);
＿if not result then begin
＿＿AlrtDialog('面図形の移動に失敗しました。'); Goto 999;
＿end;
＿DSelectAll;
＿SetSelect(hP);
＿SetPrefInt(55, dv);
＿DoMenuTextByName('Convert to Polygons', 0);
＿SetPrefInt(55, oldDv*2);
＿hP:= LSActLayer;
＿n:= GetVertNum(hP);
＿Allocate p[1..n+1];
＿Allocate v[1..n+1];
＿Allocate lng[1..n+1];
＿for i:= 1 to n do
＿＿GetPolyPt(hP, i, p[i].x, p[i].y);
＿if IsPolyClosed(hP) then begin
＿＿n:= n + 1;
＿＿p[n]:= p[1];
＿end;
＿Message('N=', n);
＿Get3DInfo(h, ht, wd, depth);
＿GetLocPt(hL, xC, yC);
＿lng[1]:= Distance3D(xC, yC, depth, p[1].x, p[1].y, 0);
＿v[1].x:= lng[1];
＿v[1].y:= 0;
＿ang:= 0;
＿BeginGroup;
＿＿ClosePoly;
＿＿for i:= 2 to n do begin
＿＿＿lng[i]:= Distance3D(xC, yC, depth, p[i].x, p[i].y, 0);
＿＿＿d:= Distance(p[i].x, p[i].y, p[i-1].x, p[i-1].y);
＿＿＿rot:= TriDists2Ang(d, lng[i], lng[i-1]);
＿＿＿ang:= Vec2Ang(v[i-1]);
＿＿＿v[i].x:= lng[i] * Cos(rot + Deg2Rad(ang));
＿＿＿v[i].y:= lng[i] * Sin(rot + Deg2Rad(ang));
＿＿＿Poly(0, 0, v[i-1].x, v[i-1].y, v[i].x, v[i].y);
＿＿＿hTr:= LNewObj;
＿＿＿HMove(hTr, x0, y0);
＿＿end;
＿EndGroup;
＿DelObject(hP);
999:
end;
Run(ExpandPyramid);

ありがとうございます。
もしかしたら、隠しコマンドが・・・なんて期待してましたが、
解りました。
LinearDimですね。

Hなクマさん、こん○○は。

＞[-----××-----]
選択している直線を寸法線に変換する機能ですが、スクリプトでは実行できません。
直線のハンドルから端点の座標を取って、LinearDimで寸法線を描いてください。

教えて下さい
「属性パレット」の中の「線分設定」のところに「-----××-----」というものが有りますが、これをスクリプトで指定する時はどうしたら良いのですか？

Hなくまさん
与太郎さん

ありがとうございました。
お２人のご意見を参考にやってみます。

オレは丸ゴシックが好きだから、
TextFont(16703);
でやってる。
16703は丸ゴシックのフォント番号
フォント番号は
GetTextFont(h,1);｛hはアクティヴな文字｝
で番号がわかる。

確かに「フォント」の項目が見当たりませんね...

ダメ元で試したら DoMenuTextByName('Font', 1); で出来ました。
設定したいフォントがメニューの何番目なのかはマシンごとに違うと思います。

与太郎さん　ありがとうございました。
文字の種類を指定したフォントに変更するやりかたは分かりますか？
"Additional Resources 付録"をみても詳しく載っていなかったので。
よろしくお願いします。

「左よせ」なら、DoMenuTextByName('Text Horizontal Alignment', 1); となります。
２番目のパラメータは上から　1：「左よせ」、2：「センタ」、3：「右よせ」です。
個々のコマンド名は、VS Function Referenceの「Additional Resources 付録」に載っています。

＞管理人さま
＞ううむ、推察しちゃうと短くはこたえられないかも、かな？

残念でした。与太郎だって簡潔に答えられますよー。

はじめまして。
DoMenuTextで文字の種類や位置（左よせ、右よせ等）を使っていたのですが
DoMenuTextByNameで設定するにはどうすればよいのでしょうか。

Hなくまさんへ

文字化け部分の原文を教えて頂き、かさねがさね有難う御座います。

与太郎さま、しんいちさま、そして皆さま。
スクリプトの文字化け、失礼しました。
元の文字列は、
objH:=FSActLayer;{n�e^oee´E^i`ae}
--> objH:=FSActLayer;{面積取得}

AddField('室名記入',3,1,10,40,60,55);
--> AddField('室　名：',3,1,10,40,60,55);

AddField('算定面積',5,1,10,65,69,80);
--> AddField('面　積：',5,1,10,65,69,80);

AddField('�u´坪',6,1,122,65,135,80);
--> AddField('�u',6,1,122,65,135,80);

AddField('面積記入ツール',8,1,10,10,300,25);EndDialog;
--> AddField('＜＜　室名スタンプ　＞＞',8,1,10,10,300,25);EndDialog;

RTr:=Round(RSr*100*0.3025)/100;{i´y¨C…a¨�覇´Z}
--> RTr:=Round(RSr*100*0.3025)/100;{坪に換算}

です（意味が通れば、何でも良いのですが・・・）。
単純に、スクリプトを開いてコピー・ペーストしただけだったのですが・・・・
申訳ありませんでした。
図面にスタンプされる「�u」を「m2」としたのは、Mac<-->Winで図面をやり取りした時に、文字化けしたためです。
実は、この書込も私の「�u」は「a´u」と化けておりました。

Hなくまさんへ
文字化け部分を勝手に改変してごめんなさい

{室名スタンプby KUMA
---------------------------------------------------}
PROCEDURE RSTAMP;

LABEL 1,2;

CONST
kDialogWidth=190;
kDialogHeight=180;
VAR
Bx,By,RSr,RTr,TitleWidth:REAL;
RSl:LONGINT;
item,dx1,dy1,dx2,dy2,x1,y1,SCi:INTEGER;
objH,h1:HANDLE;
RNs,RSs,RTs:STRING;

Procedure centerBounds(VAR xl,yl,x2,y2:INTEGER);
VAR
sxl,sx2,syl,sy2:INTEGER;
BEGIN
GetScreen(sxl,syl,sx2,sy2);
xl:=(sxl+sx2)/2-kDialogWidth/2;
yl:=(syl+sy2)/2-kDialogHeight/2;
x2:=(sxl+sx2)/2+kDialogWidth/2;
y2:=(syl+sy2)/2+kDialogHeight/2;
END;

Begin
GetPt(x1,y1);
PushAttrs;
objH:=FSActLayer;{n�e^oee´E^i`ae}
DSELECTALL;
RSr:=Round(HArea(objH)/10000-0.5)/100;
RSs:=Num2Str(2,RSr);
if objH=NIL THEN RSs:='';
centerBounds(dx1,dy1,dx2,dy2);
BeginDialog(1,1,dx1,dy1,dx2,dy2);
AddButton('O K',1,1,110,145,170,165);
AddButton('Cancel',2,1,20,145,90,165);
AddField('室名記入',3,1,10,40,60,55);
AddField('',4,2,70,40,160,55);
AddField('算定面積',5,1,10,65,69,80);
AddField('�u´坪',6,1,122,65,135,80);
AddField(RSs,7,2,70,65,118,80);
AddField('面積記入ツ−ル',8,1,10,10,300,25);EndDialog;
GetDialog(1);
SelField ( 4 );
REPEAT
DialogEvent(item);
UNTIL (item=1) OR (item=2);
RNs:=GetField(4);
RSs:=GetField(7);
if item=2 THEN GOTO 1;
ClrDialog;

h1:=ActLayer;
SCi:=GetLScale(h1);
Bx:=8*SCi;
By:=2.5*SCi;
RSr:=Str2Num(RSs);
RTr:=Round(RSr*100*0.3025)/100;{i´y¨C…a¨�覇´Z}
RTs:=Num2Str(2,RTr);

GetPt(x1,y1);
BeginGroup;
FillPat(0);
TextSize(12);TEXTJUST(2);TextVerticalAlign(1);
TEXTORIGIN(x1,y1+By*0.8);
BEGINTEXT;
Concat(RNs)
ENDTEXT;
TitleWidth:=HWidth(LNewObj);
dselectAll;
If (1.8*Bx<TitleWidth) then Bx:= TitleWidth/1.8;
FillPat(1);
PenSize(10);
Rect(x1-Bx,y1+By,x1+Bx,y1-By);
MoveBack;
if (RSs='') THEN GOTO 2;
FillPat(0);
TextSize(9);
TEXTORIGIN(x1,y1-By*1.0);
BEGINTEXT;
Concat(RSs,'�u
(',RTs,'坪)')
ENDTEXT;
2:EndGroup;
DSELECTALL;
RedrawAll;

PopAttrs;
1:END;

Run(RSTAMP);


これで想定した面積記入が出来ましたので報告します。

Hなくまさんへ

{室名スタンプby KUMA
---------------------------------------------------}

PROCEDURE RSTAMP;

LABEL 1,2;

CONST
kDialogWidth=190;
kDialogHeight=180;
VAR
Bx,By,RSr,RTr,TitleWidth:REAL;
RSl:LONGINT;
item,dx1,dy1,dx2,dy2,x1,y1,SCi:INTEGER;
objH,h1:HANDLE;
RNs,RSs,RTs:STRING;

Procedure centerBounds(VAR xl,yl,x2,y2:INTEGER);
VAR
sxl,sx2,syl,sy2:INTEGER;
BEGIN
GetScreen(sxl,syl,sx2,sy2);
xl:=(sxl+sx2)/2-kDialogWidth/2;
yl:=(syl+sy2)/2-kDialogHeight/2;
x2:=(sxl+sx2)/2+kDialogWidth/2;
y2:=(syl+sy2)/2+kDialogHeight/2;
END;

Begin
GetPt(x1,y1);
PushAttrs;
objH:=FSActLayer;{n�e^oee´E^i`ae}
DSELECTALL;
RSr:=Round(HArea(objH)/10000-0.5)/100;
RSs:=Num2Str(2,RSr);
if objH=NIL THEN RSs:='';
centerBounds(dx1,dy1,dx2,dy2);
BeginDialog(1,1,dx1,dy1,dx2,dy2);
AddButton('O K',1,1,110,145,170,165);
AddButton('Cancel',2,1,20,145,90,165);
AddField('e´∫A°@n?A°F',3,1,10,40,60,55);
AddField('',4,2,70,40,160,55);
AddField('n�A°@e^oeA°F',5,1,10,65,69,80);
AddField('a´u',6,1,122,65,135,80);
AddField(RSs,7,2,70,65,118,80);
AddField('A°E´A°E´A°@e´∫n?E´XE´^E´i`E´vA°@A°NA°N',8,1,10,10,300,25);EndDialog;
GetDialog(1);
SelField ( 4 );
REPEAT
DialogEvent(item);
UNTIL (item=1) OR (item=2);
RNs:=GetField(4);
RSs:=GetField(7);
if item=2 THEN GOTO 1;
ClrDialog;

h1:=ActLayer;
SCi:=GetLScale(h1);
Bx:=8*SCi;
By:=2.5*SCi;
RSr:=Str2Num(RSs);
RTr:=Round(RSr*100*0.3025)/100;{i´y¨C…a¨�覇´Z}
RTs:=Num2Str(2,RTr);

GetPt(x1,y1);
BeginGroup;
FillPat(0);
TextSize(12);TEXTJUST(2);TextVerticalAlign(1);
TEXTORIGIN(x1,y1+By*0.8);
BEGINTEXT;
Concat(RNs)
ENDTEXT;
TitleWidth:=HWidth(LNewObj);
dselectAll;
If (1.8*Bx<TitleWidth) then Bx:= TitleWidth/1.8;
FillPat(1);
PenSize(10);
Rect(x1-Bx,y1+By,x1+Bx,y1-By);
MoveBack;
if (RSs='') THEN GOTO 2;
FillPat(0);
TextSize(9);
TEXTORIGIN(x1,y1-By*1.0);
BEGINTEXT;
Concat(RSs,'�u←修正しました
(',RTs,坪')←修正しました

ENDTEXT;
2:EndGroup;
DSELECTALL;
RedrawAll;

PopAttrs;
1:END;

Run(RSTAMP);

で記入できました。

後は与太郎のレスと同じでダイアログボックス内が
文字化けしています。

＞Hなクマさん

ソースの日本語が文字化けしてるんですけど...

与太郎さんへ
A&A社のサポ−トを受け
ファイル→書類設定→単位→面積→カスタム
で見掛けの坪数の数値は確認できることを教わりました。

Hなクマさんへ
スクリプトを掲載していただいて有難う御座います。
私が欲していたスクリプトです。

　質問等はこれからは談話室へ投稿するように致しますので
宜しく御願いいたします。

むかし、スクリプトに興味を持ったころのことを思い出し、
はずかしながらですが、それを晒します。参考にして下さい。
動くと思います。

{室名スタンプby KUMA
---------------------------------------------------}

PROCEDURE RSTAMP;

LABEL 1,2;

CONST
kDialogWidth=190;
kDialogHeight=180;
VAR
Bx,By,RSr,RTr,TitleWidth:REAL;
RSl:LONGINT;
item,dx1,dy1,dx2,dy2,x1,y1,SCi:INTEGER;
objH,h1:HANDLE;
RNs,RSs,RTs:STRING;

Procedure centerBounds(VAR xl,yl,x2,y2:INTEGER);
VAR
sxl,sx2,syl,sy2:INTEGER;
BEGIN
GetScreen(sxl,syl,sx2,sy2);
xl:=(sxl+sx2)/2-kDialogWidth/2;
yl:=(syl+sy2)/2-kDialogHeight/2;
x2:=(sxl+sx2)/2+kDialogWidth/2;
y2:=(syl+sy2)/2+kDialogHeight/2;
END;

Begin
GetPt(x1,y1);
PushAttrs;
objH:=FSActLayer;{n�e^oee´E^i`ae}
DSELECTALL;
RSr:=Round(HArea(objH)/10000-0.5)/100;
RSs:=Num2Str(2,RSr);
if objH=NIL THEN RSs:='';
centerBounds(dx1,dy1,dx2,dy2);
BeginDialog(1,1,dx1,dy1,dx2,dy2);
AddButton('O K',1,1,110,145,170,165);
AddButton('Cancel',2,1,20,145,90,165);
AddField('e´∫A°@n?A°F',3,1,10,40,60,55);
AddField('',4,2,70,40,160,55);
AddField('n�A°@e^oeA°F',5,1,10,65,69,80);
AddField('a´u',6,1,122,65,135,80);
AddField(RSs,7,2,70,65,118,80);
AddField('A°E´A°E´A°@e´∫n?E´XE´^E´i`E´vA°@A°NA°N',8,1,10,10,300,25);EndDialog;
GetDialog(1);
SelField ( 4 );
REPEAT
DialogEvent(item);
UNTIL (item=1) OR (item=2);
RNs:=GetField(4);
RSs:=GetField(7);
if item=2 THEN GOTO 1;
ClrDialog;

h1:=ActLayer;
SCi:=GetLScale(h1);
Bx:=8*SCi;
By:=2.5*SCi;
RSr:=Str2Num(RSs);
RTr:=Round(RSr*100*0.3025)/100;{i´y¨C…a¨�覇´Z}
RTs:=Num2Str(2,RTr);

GetPt(x1,y1);
BeginGroup;
FillPat(0);
TextSize(12);TEXTJUST(2);TextVerticalAlign(1);
TEXTORIGIN(x1,y1+By*0.8);
BEGINTEXT;
Concat(RNs)
ENDTEXT;
TitleWidth:=HWidth(LNewObj);
dselectAll;
If (1.8*Bx<TitleWidth) then Bx:= TitleWidth/1.8;
FillPat(1);
PenSize(10);
Rect(x1-Bx,y1+By,x1+Bx,y1-By);
MoveBack;
if (RSs='') THEN GOTO 2;
FillPat(0);
TextSize(9);
TEXTORIGIN(x1,y1-By*1.0);
BEGINTEXT;
Concat(RSs,'m2
(',RTs,'i´y¨)')
ENDTEXT;
2:EndGroup;
DSELECTALL;
RedrawAll;

PopAttrs;
1:END;

Run(RSTAMP);

VW談話室向けの質問だと思いますが...

VW12なら単位設定を変えれば、面積をデータパレットに坪単位で表示出来ます。

単位設定のポップアップメニューの中に「坪」はないので、カスタム単位を作ります。
面積の単位を「カスタム」にして、「カスタム...」ボタンを押すと設定ダイアログが開くので、
１カスタム単位で(H)「0.3025」「平方メートル」　と設定します。
単位の名前も「坪」にしとけば良いでしょう。

単位設定を変えたくないなら、以下の１行スクリプト、
Message(HArea(LSActLayer), 'm2 (', HArea(LSActLayer) * 0.3025, '坪)');{ 単位がｍの場合 }
または、
Message(HArea(LSActLayer), 'mm2 (', HArea(LSActLayer) * 0.3025 / 1000000, '坪)');{ 単位がm/mの場合 }
でアクティブレイヤの選択図形（の内で一番上の図形）の面積を確認出来ます。
Win版ならメッセージウインドウから数字をコピーすることも出来ます。

ワークシートで坪表示させるときも、同じように換算すればいいです。

Vectorworks12J使用の初心者です
室面積は
ファイル→単位→面積→単位→平方メ−トル
で確認できるのですが

例　123.45�u
　（37.34坪）

Vector Scriptで上記のように記入する方法を教えて下さい。

与太郎さん有難う御座います。
12.0Jではツ−ル→作業画面→クラシック
（線分選択後）→加工→線分を合成
で標準コマンドで出来ることが判りました。

このHPがAutocadのmura's home（http://www.mura.sh/）のように
活発に意見交換ができるように利用させていただきますので
宜しくお願い致します。

スクリプトの48行目か、その直前にエラーがあります。
「プラグインコマンド...」の「コマンド編集」ボタンで編集可能なら、VW12で動くように修正出来ます。
編集出来ない（ロックが掛かっている）場合は諦めましょう。

Vectorworks12J使用の初心者です
線分結合ツ−ルを1999年版で見つけ上記で使用したところ
Vector Script エラ−
エラ−を確認
Line #48:
(Error:Did not expect this after end of statement-missing:?)
と表示され線分は結合されませんでした。

使用方法
2直線を端を揃えて作図
2直線を選択後線分結合ツ−ルをクリック

Vectorworks12Jでは使用できないのでしょうか？

与太郎さん　こんにちは。そして有り難うございます。

goto文出来ないかと思ってましたが、はじめに宣言しないといけなかったんですね。
それから、ダイアログ関数を定義してる例ですが、思いもつかない方法でした。
いろいろ勉強になります。
勝手に雛形に使わせていただこうと思います。
有り難うございました。

VectorScriptでは、どんなプログラムでもGoto文を使わずに書けます。
ただし、ループやサブルーチンを途中で中断するといった例外処理では、Goto文を使ったほうが簡潔
に書けることもあります。

下のprocedure test_ifとprocedure test_gotoでは、後者のほうが入力項目の追加や削除が簡単です。

procedure test_if;
var
＿＿i, j, k＿＿:integer;
begin
＿＿i:= IntDialog('i=', '1');
＿＿if not DidCancel then begin
＿＿＿＿j:= IntDialog('j=', '2');
＿＿＿＿if not DidCancel then begin
＿＿＿＿＿＿k:= IntDialog('k=', '3');
＿＿＿＿＿＿if not DidCancel then begin
＿＿＿＿＿＿＿＿{目的の処理}
＿＿＿＿＿＿end;
＿＿＿＿end;
＿＿end;
end;
Run(test_if);

procedure test_goto;
label
＿＿9999;
var
＿＿i, j, k＿＿:integer;
begin
＿＿i:= IntDialog('i=', '1'); if DidCancel then GoTo 9999;
＿＿j:= IntDialog('j=', '2'); if DidCancel then GoTo 9999;
＿＿k:= IntDialog('k=', '3'); if DidCancel then GoTo 9999;
＿＿{目的の処理}
9999:
end;
Run(test_goto);

変数やダイアログ・サブルーチンを工夫すれば、GoTo文を使わなくてもネストが深くならないように
出来ます。

procedure test_var;
var
＿＿continues＿＿boolean;
＿＿i, j, k＿＿:integer;
begin
＿＿continues:= true;
＿＿i:= IntDialog('i=', '1'); if DidCancel then continues:= false;
＿＿j:= IntDialog('j=', '2'); if DidCancel then continues:= false;
＿＿k:= IntDialog('k=', '3'); if DidCancel then continues:= false;
＿＿if continues then begin
＿＿＿＿{目的の処理}
＿＿end;
9999:
end;
Run(test_var);

procedure test_func;
var
＿＿i, j, k＿＿:integer;
＿＿
＿＿function WrapedIntDialog(request, default:string; var ii:integer):boolean;
＿＿begin
＿＿＿＿ii:= IntDialog(request, default);
＿＿＿＿if DidCancel then
＿＿＿＿＿＿WrapedIntDialog:= false
＿＿＿＿else
＿＿＿＿＿＿WrapedIntDialog:= true;
＿＿end;{WrapedIntDialog}
＿＿
begin{main}
＿＿if not WrapedIntDialog('i=', '1', i)then begin {例外処理1} end
＿＿else if not WrapedIntDialog('j=', '2', j)then begin {例外処理2} end
＿＿else if not WrapedIntDialog('k=', '3', k)then begin {例外処理3} end
＿＿else begin
＿＿＿＿{目的の処理}
＿＿end;
end;{main}
Run(test_func);

procedure Baloonで、DidCancelの処理を忘れてしまいましたね(^_^; 。

quit:= false; を、 num:= IntDialog ('開始番号は？','1'); の前に移動して、

quit:= false;
num:= IntDialog ('開始番号は？','1'); if DidCancel then quit:= true;
dia:= RealDialog ('バルーンの直径を入力してください。','500');　if DidCancel then quit:= true;
autoLength:= YNDialog('矢印長さを自動設定にしますか？');　if DidCancel then quit:= true;

とすれば良いと思われます。

＞x0:= 987654.321; y0:= x0;この意味がわかりません。
＞何をするものですか？

げっ、そこは触れないでほしかった...
理由はtomo2000さんの書いたとおりです。

整数型変数 firstNum を追加して、
初期値を firstNum:= num; で記憶しておいて、
if Distance(x0, y0, x2, y2) <= (pDia) then begin ではなく、
if (Distance(x0, y0, x2, y2) <= (pDia)) & (firstNum <> num) then begin とすべきでした。

こんにちは。
またまた初心者的質問で恐縮ですが、

ダイアログを表示させて、キャンセルが押された場合処理を終了させる。には、
if not didcancel then bigin
　処理;
end;
でどんどんネストさせてさせていくんでしょうか？
VBの様にExit subで抜けたり、或いはgotoで処理を飛ばしたり出来ないのかと思いまして。
すみませんがよろしくお願いいたします。

Hなクマさん はじめまして。
ちょっとのぞいてみたらまたレスされてて感激です。

>x0:= 987654.321; y0:= x0;この意味がわかりません。

ですが、(0,0)付近にバルーンを作成しようとした際、いきなり終了という事態を
回避するための物と思いました。(与太郎さん作成scriptの場合)
Hなクマさん 作成の物ははじめにgetpt(x0,y0)としてるため、この問題は発生しません。

と思います。

tomo2000さん、与太郎さん　初めまして。
久しぶりに覗いたScriptのコーナー。
与太郎さんの非常にわかりやすいスクリプトに、思わず感涙し、
おこがましくも、いじってしまいました。
改良（？）してると思いましたので、ちょっと発表します。
変更点：
　・レイヤーの縮尺に関係なく同じ大きさの○、文字がスタンプされます。
　・最初の引き出し線の描き出しタイミングを番号設定の後にしました。
　・終了の形をハッキリさせました。

で、質問：
　x0:= 987654.321; y0:= x0;この意味がわかりません。
　何をするものですか？


procedure Balloon;
const
{$ DEBUG}
{パラメータ}
pStep = 1; {番号の増加分}
{pDia = 500; }{円の直径}
pTxtSize=10;{文字サイズ}
pMkrSize = 2.5; {マーカーサイズ}
pAutoLength = false; {自動引出し線長さのOn/Off}
pDefLength = 500/2/0.6; {引出し線長さのデフォルト値}
{拘束パラメータ}
Tp = 1; {同一点拘束}
P1a = 2; {直線の2DPt番号　2:終点}
P1b = -1; {同一点拘束だと２点目が無いから[-1]なのか？}
P2a = 1; {円の2DPt番号　1:中心}
P2b = -1; {同一点拘束だと２点目が無いから[-1]なのか？}
C1 = 0; {h1はグループ図形ではないのでゼロでいいのか？}
C2 = 2; {円はグループ内で上から２番目の図形なので[2]で間違いないと思う}
var
num:integer; {番号}
ang,pDia,Scl :real; {引出し線の角度、円の直径、レイヤー縮尺}
x1, y1, x2, y2:real; {矢印先端と円の中心}
x0, y0:real; {直前の円の中心}
h1, h2:handle; {直線、グループ図形のハンドル}
quit:boolean; {ループ終了フラグ}
result:boolean;
v:vector; {ΔX、ΔY（角度算出にも使用）}
begin{main}
PushAttrs;
GetPt(x0, y0);
Scl:=GetLScale(ActLayer);
num := IntDialog ('開始番号は？','1');
Marker(1, pMkrSize/25.4, 15); {マーカーサイズの調整}
pDia:=pTxtSize*0.4*Scl;{文字サイズにあわせた○}
{x0:= 987654.321; y0:= x0;この意味がわからない？}
quit:= false;
while not quit do begin {quitがTrueになるまでループ}
Message(num,'：引き出し線を引いて下さい。(終点再度クリックで終了)');
GetLine(x1, y1, x2, y2);
if Distance(x0, y0, x2, y2) <= (pDia) then begin
quit:= true;
end
else begin
DSelectAll;
if EqualPt(x1, y1, x2, y2) then begin
h1:= nil;
end{if}
else begin
if pAutoLength then begin
v.x:= x2 - x1; v.y:= y2 - y1;
ang:= Vec2Ang(v);
v:= Ang2Vec(ang, pDefLength);
x2:= v.x + x1; y2:= v.y + y1;
end;{if}
PenSize(1);
MoveTo(x1, y1);
LineTo(x2, y2);
h1:= LNewObj;
end;{else}
BeginGroup;
FillPat(1);
PenSize(10);
ArcByCenter(x2, y2, pDia/2, 0, 360);
FillPat(0);
PenSize(1);
TextJust (2);
TextVerticalAlign(3);
TextOrigin (x2, y2);
TextSize(pTxtsize);
CreateText(Num2Str(0, num));
num := num + pStep;
EndGroup;
h2:= LNewObj;{h2は円ではなくグループ図形のハンドルにしないと、円しか拘束されない。}
if h1 <> nil then begin
result:= SetBinaryConstraint(Tp, h1, h2, P1a, P1b, P2a, P2b, C1, C2);
SetSegPt1(h1, x1, y1);
end;{if}
end;{if}
ReDraw;
x0:= x2; y0:= y2;
end;{while}
ClrMessage;
DSelectAll;
PopAttrs;
SETTOOL(2);
end;{main}
Run(Balloon);

あぁぁ。。与太郎さん有り難うございます。

３日でといっても、基本的な関数しか使って無いですし、投稿するのを
少しためらったんですが、褒めていただいて嬉しいです。
（褒められて伸びるタイプなんです。）

本題については、scriptの取り出ししても拘束については書き出してくれないし、どうした物かと半ばあきらめムードでした。
あとbooleanで図面を適用させることを知らなかったので、もっと基本を勉強しようと思いました。 デバッグモードも初めて知りました。

まずは書いていただいたscriptの内容を確認しながら勉強させていただきます。
masafumiさん、与太郎さん　また質問させてくださいね。
どうも有り難うございました。

tomo2000さん、こんにちは。

＞３日でこれだけの script が書けるなんて・・・すごいですね。
一瞬、差し出しかけた手を引っ込めようかと、邪悪な考えが脳裏をよぎりました（若手潰しぢゃ）。
でもすぐに反省したし、大盤振る舞いで回答しますから、聞かなかった事にしてくださいね（笑）。

＞SetBinaryConstraint
確かに、VS Function Referenceの説明だけではお手上げです。
パラメータを１個づつ変えて試しても埒が明かないので、
拘束ツールをデバッガで走らせて、SetBinaryConstraintのパラメータを調べました。
条件を変えると？？？ですが、一応必要なことだけは判ったので、スクリプトを書き直して
みました。「＿＿」をタブに変換してから実行してください。

procedure Balloon;
const
{$ DEBUG}
＿＿{パラメータ}
＿＿pStep = 1; {番号の増加分}
＿＿pDia = 500; {円の直径}
＿＿pMkrSize = 2.5; {マーカーサイズ}
＿＿pAutoLength = false; {自動引出し線長さのOn/Off}
＿＿pDefLength = 500/2/0.6; {引出し線長さのデフォルト値}
＿＿{拘束パラメータ}
＿＿Tp = 1; {同一点拘束}
＿＿P1a = 2; {直線の2DPt番号　2:終点}
＿＿P1b = -1; {同一点拘束だと２点目が無いから[-1]なのか？}
＿＿P2a = 1; {円の2DPt番号　1:中心}
＿＿P2b = -1; {同一点拘束だと２点目が無いから[-1]なのか？}
＿＿C1 = 0; {h1はグループ図形ではないのでゼロでいいのか？}
＿＿C2 = 2; {円はグループ内で上から２番目の図形なので[2]で間違いないと思う}
var
＿＿num＿＿:integer; {番号}
＿＿ang＿＿:real; {引出し線の角度}
＿＿x1, y1, x2, y2＿＿:real; {矢印先端と円の中心}
＿＿x0, y0＿＿:real; {直前の円の中心}
＿＿h1, h2＿＿:handle; {直線、グループ図形のハンドル}
＿＿quit＿＿:boolean; {ループ終了フラグ}
＿＿result＿＿:boolean;
＿＿v＿＿:vector; {ΔX、ΔY（角度算出にも使用）}
begin{main}
＿＿PushAttrs;
＿＿num := IntDialog ('開始番号を入力してください。','1');
＿＿Marker(1, pMkrSize/25.4, 15); {マーカーサイズの調整}
＿＿x0:= 987654.321; y0:= x0;
＿＿quit:= false;
＿＿while not quit do begin {quitがTrueになるまでループ}
＿＿＿＿Message(num,'：始点と終点を指定してください。(最後の円の中でクリック＝終了)');
＿＿＿＿GetLine(x1, y1, x2, y2);
＿＿＿＿if Distance(x0, y0, x2, y2) <= (pDia/2) then begin
＿＿＿＿＿＿quit:= true;
＿＿＿＿end
＿＿＿＿else begin
＿＿＿＿＿＿DSelectAll;
＿＿＿＿＿＿if EqualPt(x1, y1, x2, y2) then begin
＿＿＿＿＿＿＿＿h1:= nil;
＿＿＿＿＿＿end{if}
＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿if pAutoLength then begin
＿＿＿＿＿＿＿＿＿＿v.x:= x2 - x1; v.y:= y2 - y1;
＿＿＿＿＿＿＿＿＿＿ang:= Vec2Ang(v);
＿＿＿＿＿＿＿＿＿＿v:= Ang2Vec(ang, pDefLength);
＿＿＿＿＿＿＿＿＿＿x2:= v.x + x1; y2:= v.y + y1;
＿＿＿＿＿＿＿＿end;{if}
＿＿＿＿＿＿＿＿MoveTo(x1, y1);
＿＿＿＿＿＿＿＿LineTo(x2, y2);
＿＿＿＿＿＿＿＿h1:= LNewObj;
＿＿＿＿＿＿end;{else}
＿＿＿＿＿＿BeginGroup;
＿＿＿＿＿＿＿＿ArcByCenter(x2, y2, pDia/2, 0, 360);
＿＿＿＿＿＿＿＿TextJust (2);
＿＿＿＿＿＿＿＿TextVerticalAlign(3);
＿＿＿＿＿＿＿＿TextOrigin (x2, y2);
＿＿＿＿＿＿＿＿TextSize(pDia/75);
＿＿＿＿＿＿＿＿CreateText(Num2Str(0, num));
＿＿＿＿＿＿＿＿num := num + pStep;
＿＿＿＿＿＿EndGroup;
＿＿＿＿＿＿h2:= LNewObj;{h2は円ではなくグループ図形のハンドルにしないと、円しか拘束されない。}
＿＿＿＿＿＿if h1 <> nil then begin
＿＿＿＿＿＿＿＿result:= SetBinaryConstraint(Tp, h1, h2, P1a, P1b, P2a, P2b, C1, C2);
＿＿＿＿＿＿＿＿SetSegPt1(h1, x1, y1);
＿＿＿＿＿＿end;{if}
＿＿＿＿end;{if}
＿＿＿＿ReDraw;
＿＿＿＿x0:= x2; y0:= y2;
＿＿end;{while}
＿＿ClrMessage;
＿＿PopAttrs;
end;{main}
Run(Balloon);

＞{$ DEBUG}
このままではただのコメント文ですが、スペースを取って{$DEBUG}とすると、スクリプトはデ
バッガモードで実行します。１文字の変更なので手早くモードを変えられます。

＞PushAttr、PopAttrs
スクリプトの中で書類の属性設定を変えるとき、実行後に設定を元に戻したいなら、
最初に PushAttr; で属性設定を保存して、最後に PopAttrs; で属性設定を元に戻します。
これをしないと、このスクリプトを実行するたびに書類の文字属性設定が変わってしまいます。

＞ループ終了条件
直前に描いた円の中でクリックしたらループを終了するようにしました。
丸と矢印の先端を重ねて描くことはないだろうとの判断からです。

＞座標の取得
クリック−ドラッグで座標を取得するように変えています。
ボタンを押す回数が減るのと、Mac使い故こっちほうが慣れているという理由で変更しましたが、
クリック−クリックのほうが使いやすいという人も多いでしょう。

＞DSelectAll;
スクリプトを実行するうちに図形選択ハンドルだらけになるのが見苦しいと思ったので、最後の
図形以外は選択解除しました。

＞if EqualPt(x1, y1, x2, y2) then...
第１点と第２点が同じ場合、直線は生成されないので、拘束に失敗して警告ダイアログが出ます。
それを回避するために処理を分けています。
ここでは直線を描かないようにしましたが、どちらかの座標をずらして極短い直線を描いたほう
が良かったかもしれません。

＞パラメータの定数化
テストで何度も実行すると入力ダイアログが煩わしいので、円の直径等を定数にしてしまいました。
名前の頭に'p'を付けているのは、プラグイン・ツール化の布石です。

＞SetBinaryConstraintの引数
図形の頂点番号というのは、Get2DPtの引数と同じもののようです。
番号と点の位置は図形の種類によって違います。

＞SetSegPt1(h1, x1, y1);
何らかの理由で円の中心以外に拘束した場合、直線が移動して始点の位置がずれます。
位置ずれを防ぐため、直線の始点座標を再設定しています。（保険ですが必要ないかも。）

＞ReDraw;
新しいバージョンではReDrawがなくてもスクリプトで描いた図形を表示してくれることが多いですが、
長年の習慣でReDraw、ReDrawAllを多用してしまいます。

＞ClrMessage;
スクリプト実行後、情報を残すためにメッセージウインドウを開きっぱなしにすることもありますが、
今回は必要ないので閉じました。
ウインドウを閉じることで、スクリプトの終了が判りやすいという効果もあります。

masafumiさん　夜遅くご返事有り難うございます。

拘束について、言葉足らずでした。
線分の終点と円の中心を同一点拘束したい。ということです。
こうしとけば、後でバルーンの位置or矢印方向を変更したいとき楽かなっと思いまして。
あと、終了処理も分からなかったので1000で終わりとかしてますが、カッコ悪ですね。

勉強して頑張ってみます。が分かる方いらっしゃれば引き続きお願いいたします。

こんばんは tomo2000 さん。masafumiと言います。

３日でこれだけの script が書けるなんて・・・すごいですね。
他からの返事が無いようなので、私の解る範囲でお答えします。
プログラムで作成した図形のハンドルを取得するなら

FUNCTION LNewObj :HANDLE ;

でも取得できます。一度リファレンスでチェックしてみて下さい。
それから setbinaryconstraint 試してみましたが私にも良く解りません。(^_^;)
これに関しては、他からの解答待ちと言うことで・・・。

円を線分の終端、又は線分に接する位置に移動したいのでしたら、移動したい位置の
座標を計算し、現在の位置との差（ΔＸ，ΔＹ）を出して、

PROCEDURE HMove ( h :HANDLE; xOffset :REAL; yOffset :REAL) ;

で移動することも出来ます。頑張って下さい。

はじめまして。vectorscriptをはじめて3日目の初心者です。

PROCEDURE Balloon;
VAR
kaisi : integer; {開始番号}
syutu : string; {文字出力用変数}
p : integer;{変数}
z : real;
nagasa : real;{矢印長さ}
x1,y1 :real; {一点目・・矢印先端}
x2,y2 :real; {二点目・・○の中心}
ensize :real; {円のサイズ}
h1,h2 :handle;{ハンドル}
BEGIN
kaisi := intdialog ('開始番号を入力してください。','1');
ensize := realdialog ('バルーンの大きさ(直径)を入力してください。','500');
ensize := ensize / 2;
p := intdialog ('矢印長さの設定。0で手動。1で自動','1');
if p = 1 then
begin
nagasa := ensize + ensize/0.6;
end;
marker(1,ensize/2540,15); {マーカーサイズの調整}
while kaisi < 1000 do begin
message(h1,' ',h2,'1点目をポイントしてください');
getpt(x1,y1);
message('2点目をポイントしてください');
getpt(x2,y2);
if p = 1 then
begin
z := distance(x1,y1,x2,y2);
x2 := nagasa * (x2 - x1) / z + x1;
y2 := nagasa * (y2 - y1) / z + y1;
end;
moveto(x1,y1);
lineto(x2,y2);
h1 := PickObject(x1,y1);
begingroup;
arcbycenter(x2,y2,ensize,0,360);
h2 :=PickObject(x2,y2);
textjust (2);
textverticalalign(3);
textorigin (x2,y2);
textsize (ensize/37.5);
begintext; num2str(0,kaisi)
endtext;
kaisi := kaisi + 1;
endgroup;
{setbinaryconstraint(1,h1,h2,?); ←引数の意味が分からない}
redraw;
end;
END;
RUN (Balloon);

処女作としてこんなのを作ってみたんですが、（バルーン作成）
円と線分を「同一線上拘束」させたいのですが、どうすればいいのか分かりません。
ハンドルの取得もこれで良いのか不明です。
どなたかお力添えを、よろしくお願いいたします。

VW談話室より―
＞同じレイヤ、クラス上で、色のみ違う線のあるCADデータについて
＞線の色ごとに別クラスに分けたい．（レイヤでもいいです．）

VWでは線種をレイヤで分けるよりクラスで分けたほうが都合がいいので、
ここではクラスを分けるスクリプトを書いてみました。

procedure SetClassByColor;
{ファイル内の全図形のクラス名を「元のクラス名(色番号)」に設定する。}

procedure DoObject(h:handle);
const
GroupObj = 11;
SymbolObj = 15;
var
col:integer;
r, g, b:longint;
begin{DoObject}
if (GetType(h) <> GroupObj) & (GetType(h) <> SymbolObj) then begin
GetPenFore(h, r, g, b);
RGBToColorIndex(r, g, b, col);
SetClass(h, Concat(GetClass(h), '(', col, ')'));
end;{if}
end;{DoObject}

begin{main}
ForEachObject(DoObject, (INSYMBOL & ALL));
end;{main}
Run(SetClassByColor);

ここでいう色番号は、カラーパレットの番号です。
IF文で条件分けすれば、特定のクラスやレイヤの図形はそのままにするといった処理も可能です。

やっと原因がわかりました！

直前に使った"別のツール"のGetPtを拾っていました！...。

下のスクリプトの"削除ツール"をDキーに割り当てて、普段から使っていたのですが、
このツールを使い終えた後、そのまま選択ツール（Xキー）に切り替えると、
一見、スクリプトは終了したように見えるのですが、
この"削除ツール"のGetPｔはまだREPEATしてる状態だったのです！
あまりに、普通に使っていたので気づかなかった...。まず、このツールから書き換えないと...。

お騒がせしました...。


procedure Del; {2003.5.5}
var
h,objH:handle;
pX, pY,p2X,p2Y,dist:REAL;
y:BOOLEAN;

Begin
h:=FSActLayer;
IF h<>NIL THEN
DoMenuTextByName('Clear',0)
ELSE
Begin
REPEAT
GetPt(pX, pY);
DelObject(PickObject(pX, pY));
ReDraw;
y:=Option;
UNTIL (y=TRUE);
End;
END;
RUN(Del);

こんばんは、masafumiです。

>それでも、クリック"後"に描けるので、"任意の位置"に描くことが可能です...。

消極的な対応で恐縮です。(^_^;)
１つ確認したいのですが

>（最初のクリックの前に円ができてしまう）

これは、ツールボタンをクリックした時点で円が描画されるっと言う事ですよね。
状況が再現出来ないので、すべて想像で書いています。

var
msg1,msg2,msg3:String;
i:integer;
BEGIN
i:=0;
・
・
・
IF(Option)THEN
bval:=TRUE
ELSE
BEGIN
Arc(p1X-r,p1Y+r,p1X+r,p1Y-r,#0,#360);
Redraw;
i:=i+1;
msg1:=Concat('i:= ',Num2StrF(i));
msg2:=Concat('p1X:= ',Num2StrF(p1X),' p1Y:= ',Num2StrF(p1Y));
msg3:=Concat('直径 ',Num2StrF(dia),' オフセット ',Num2StrF(offset));
msg1:=Concat(msg1,chr(13),msg2,chr(13),msg3);
AlrtDialog(msg1);
END;

こんな感じで、再現した時のそれぞれの値をチェックしてみるとか、
またはダイアログを使わない状態（ dia と offset の値を両方または片方を固定）で
はどうか、それとGetPt() を使用しない場合（ p1X,p1Y を固定）はどうか等々、再現
状態をチェックする必要が有りそうですね。

そして、ダメモトで・・・２箇所有る

> IF NOT DidCancel THEN 　を

IF DidCancel THEN AlrtDialog('キャンセル')
ELSE BEGIN

と変えてみるとか・・・ワラをもすがる気持ち・・・。(^_^;)

{$DEBUG}を利用してプログラムの流れや各数値をチェックすることも出来ます。

有効かどうかわかりませんが、以上チェックしてみることをお勧めします。

masafumiさん、こんにちは。

一応、masafumiさんの方法で、とりあえず、"うまく"いきます。
はじめのクリックで描けない時と、"描ける時"があるのですが、
それでも、クリック"後"に描けるので、"任意の位置"に描くことが可能です...。

ありがとうございました。

こんばんは、masafumi です。

私の環境では問題の部分は再現されません（何度やっても・・・）。
Win2000 VectorWorks10.5 です。

解決策になるか疑問ですが、フラグを１つ設定して最初の円を描くのを無効にするってのは
どうですか？。

たとえば下記のように。

VAR
flg:Boolean; -------------------------- 追加
BEGIN
flg:=False; -------------------------- 追加
DSelectall;
dia:=DistDialog('直径を入力','200');
・
・
・
ELSE
BEGIN
{-----この部分を変更-----}
if flg=True then
begin
Arc(p1X-r,p1Y+r,p1X+r,p1Y-r,#0,#360);
Redraw;
end;
flg:=True;
{-----ここまで変更-----}
END;

こんな感じです。
これですと最初にクリックした時、ダイアログが表示されてその後のクリックで円を描きます。

よく試してみたら、取得済みになってしまうポイントは、前回使用時の最後のクリックポイントでもないですね...。
よくわからないポイントに勝手に円が描けてしまいます...。

やっぱ、バグですかね...。
ただ、取得済みになってしまうのは、0，0ではなく、前回使用時の最後のクリックポイントらしいのです。勝手に円が描けてしまう場所は毎回違います...。

でも、KANABUNさんの報告と同種のバグですよね...。

T.Yabeさん、こんにちは。
バックナンバーに、こんな記述が有ります。

>初動バグ 　KANABUN
>email:　 Thu Jan 30 13:44:58 2003
>
>もあります。
>最初のワンクリック前に0,0を取得済みとしてします現象をわりと高い頻度で経験してます。
>これは解決策無しで、0,0を勝手に拾った場合のエラー分岐を付けるか、0,0の場合のリピートを
>組み込むことで解消してます。
>取得方法は私もmasafumiさんのようにGetPtでxy座標を取ってPickObjectへ代入する方法です。

これと同様な状態ではないですか。詳しくは、検索してみて下さい。

円を連続して描くツールを作ったのですが、ときどき、GetPｔを評価せずに勝手に、円を描画してしまうときがあります...。
（最初のクリックの前に円ができてしまう）

何度もこのツールを使っていて、ダイアログでキャンセルボタンを使った時の、次の使用時にそうなります。

プログラム的なミスなのか、バグなのかよくわかりません...。
どなたか、デバッグを手伝ってくださる方いませんでしょうか？
WinXP　VectorWorks12使用です。



Procedure PlotArc; {2006.5.9 T.Yabe}

VAR
p1X,p1Y,r,dia,offset: REAL;
bval:BOOLEAN;

BEGIN
DSelectall;
dia:=DistDialog('直径を入力','200');
IF NOT DidCancel THEN
BEGIN
offset:=DistDialog('オフセット','10');
IF NOT DidCancel THEN
BEGIN

PushAttrs;
FillFore(255);
FillBack(0);
FillPat(0);
PenFore(255);
PenBack(0);
PenPat(2);
PenSize(1);

REPEAT
GetPt(p1X,p1Y);
r:=dia/2;
IF(Shift)THEN r:=dia/2+offset;
IF(Command)THEN r:=dia/2-offset;
IF(Option)THEN
bval:=TRUE
ELSE
BEGIN
Arc(p1X-r,p1Y+r,p1X+r,p1Y-r,#0,#360);
Redraw;
END;
UNTIL(bval=TRUE);

PopAttrs;
END;
END;
END;
Run(PlotArc);

＞DXF/DWG Batch Converter

VectorScriptプラグインではなく、8.5用のSDKプラグインですね。
VW10で動かなかったら、それ以降のバージョンで動く見込みはありません。
でも、新しいバージョンなら標準で連続変換ができるはずです。

建築知識のDXFデーターをバッチ処理でVWデータに変えようとして下記のPLUG-INを見つけましたが
当方のバージョン(v.8J2)が古いせいか入出力のフォルダーの指定までは出来ても先に進みません。v10.1でやるとフォルダーの指定すら出ません。
どなたか追試して頂ける方はいますか
VW11.0以上を買えば良いのでしょうが。
http://www.vectordepot.com/PlugIns1.shtml

こんにちは　tomozoです。masafumiさん、はじめまして　早々
ありがとうございました。おかげさまでできました。
使用バージョンも書かずにすみませんでした。現在は10.5でした。
メニュー通りで　カッターに使用する図形を一度選ばなければいけないので
これからもう少し勉強してみます。
＞わぁ〜！。懐かしいですね。Ver2.0 のマニュアル、家にもあります。
もう20年ぐらい前になるんでしょうか？　あのパソコンはどこへいってしまったのか
私は　1　print”a"しか、もう覚えていません。

言葉足らずなところが・・・。

>選択した図形で直線を切断します。ついでに円や円弧も切断するようですのでご注意を！。

選択した図形が直線の時は、円や円弧も切断します。ですね。

こんばんは、masafumi です。

>msxのベーシックほんの少しいじったことがある程度です。

わぁ〜！。懐かしいですね。Ver2.0 のマニュアル、家にもあります。

え〜っと、「線分で切断」ですが Ver8.5 のマニュアルには書いていますが
Ver10.5 には書いていないですねぇ。色々問題が有って削除したのかな？。
取り敢えず・・・

DoMenuTextByName('Trim',0);

で動作しました。
選択した図形で直線を切断します。ついでに円や円弧も切断するようですのでご注意を！。

スクリプト初心者です。msxのベーシックほんの少しいじったことがある程度です。
メニューにある「線分を切断」を実行するコマンドはあるのでしょうか？
ClipSurfaceは　「切り欠き」のようですし　IntersectSurfaceは　希望に近いのですが精度がいまひとつで
楕円と直線などはきちんと切断されません。画面の解像度のせいかとも思いましたが　「線分を切断」だとうまくいきます。 DoMenuTextByNameの説明の中には「線分を切断」は無いようで、よくわかりませんでした。

サーバを引っ越しました。
まだ、DNSが浸透していないので、クラブが見つからない方もいらっしゃるでしょうね...m(_._)m
引っ越しに伴う不都合箇所もあると思います。
ご一報頂けると有難いです。メールが不安定なので、喫茶室にお願いします。
これまでの書き込みは右上のバックナンバーをご覧下さい。

サーバを引っ越しました。
まだ、DNSが浸透していないので、クラブが見つからない方もいらっしゃるでしょうね...m(_._)m
引っ越しに伴う不都合箇所もあると思います。
ご一報頂けると有難いです。ああ、メールが不安定なので、喫茶室にお願いします。
これまでの書き込みは右上のバックナンバーをご覧下さい。

となりのVectorWorks談話室に書くべき話題ですね。
ご質問の件については、
マニュアルで、ショートカットキーと、画面登録について学んでください。
マウスのホィールも使えます。

JWCADからVectorに移行してきました。Vectorは大変使いやすいと思いましたが
縮小拡大をするのいちいちアイコンを選択する操作がまどろっこしくて
たまりません。（この点はJWCADのほうが使いやすいかなと感じています。）
図面作成では煩雑に行う作業ですのでもっと軽快に行うことはできないでしょうか

＞メッセージウィンドウ内で文章を強制的に改行させることはできるでしょうか。

Message('1行目', Chr(13), '2行目'); とやってもダメみたいですね（13以外でも）。
ダイアログならChr(13)で改行してくれるのですが。
どうしても複数行に表示したいのなら、ワークシートに書き出すという手もありますが、
速度的にはどうなんでしょうか。

Prime7では最初の３つの素数(２，３，５)の倍数を「True」にするのを省略しています。
そして、その部分の変数は、書き込まれることはあっても一度も参照されません。
ですから、30n+[1, 7, 11, 13, 17, 19, 23, 29]以外の番号は配列変数から取り除いてもいいはずです。
そうすれば配列変数を元の8/30のサイズに圧縮出来ます。
ただし、歯抜けの配列変数は作れないので、元の数を配列上の番号に変換してから変数にアクセスします。

元の数　→　→　配列の番号
31 → 30+ 1 →　8+0 →　8
37 → 30+ 7 →　8+1 →　9
41 → 30+11 →　8+2 → 10
43 → 30+13 →　8+3 → 11
47 → 30+17 →　8+4 → 12
49 → 30+19 →　8+5 → 13
53 → 30+23 →　8+6 → 14
59 → 30+29 →　8+7 → 15
・
・
上のように 30n + x → 8n + y に変換します。
x→y つまり 1→0, 7→1, 11→2 への変換はcase文でも出来ますが、
スピードアップと（おもに）与太郎の好みのため、テーブル（配列変数）参照にします。
offsetと逆のテーブルを作るわけです。
disOffset : array[0..29] of longint; で配列を定義して、-1 に初期化したあと、
disOffset[1]:= 0; disOffset[7]:= 1; disOffset[11]:= 2; というふうに値を設定しておきます。
値が-1なら書き込み出来ない（変数が存在しない）と判断します。
ついでにoffsetの範囲を [1..8] → [0..7] に変えておきます。

ｉを元の数字とすると、配列の番号ｊは j:= 8 * (i div 30) + disOffset[i mod 30]; で計算できます。
実際は２次元配列なので、さらに list[j mod Range, j div Renge] としてやります。

procedure Prime8;
{$ DEBUG}
const
＿MaxNum = 100000;
＿MaxArray = 8 * (MaxNum div 30);
＿Limit = Trunc(Sqrt(MaxNum));
＿Range = 32768;
＿MsgStep = 1000;
＿CrStep = 20;
var
＿i, ii, j, dj, k, n, nMsg, nCr, t0, t＿:longint;
＿list＿:array[0..MaxNum div Range, 0..Range-1] of boolean;
＿offset＿:array[0..7] of longint;
＿disOffset＿:array[0..29] of longint;
＿err＿:boolean;

function GetList(i:longint):boolean;
var
＿j, k＿:longint;
begin
＿k:= disOffset[i mod 30];
＿if 0 <= k then begin
＿＿j:= 8 * (i div 30) + k;
＿＿GetList:= list[j div Range, j mod Range];
＿end
＿else begin
＿＿AlrtDialog(Concat(i, ' の値は読めません。 '));
＿＿err:= true;
＿end;
end;{GetList}

procedure SetList(i:longint; st:boolean);
var
＿j, k＿:longint;
begin
＿k:= disOffset[i mod 30];
＿if 0 <= k then begin
＿＿j:= 8 * (i div 30) + k;
＿＿list[j div Range, j mod Range]:= st;
＿end
＿else begin
＿＿{ 配列上に無いので書き込みまない }
＿end;
end;{SetList}

procedure InitList;
var
＿iH, iL＿:longint;
begin
＿Message('Inicializing...');
＿for iH:= 0 to MaxArray div Range do begin
＿＿for iL:= 0 to Range-1 do begin
＿＿＿list[iH, iL]:= false;
＿＿end;
＿＿Message('Inicializing...', iH/(MaxArray div Range)*100, '%');
＿end;
end;{InitList}

procedure WriteForm(i:longint);
begin
＿n:= n + 1;
＿Write(i);
＿if n = nCr then begin
＿＿WriteLn;
＿＿nCr:= nCr + CrStep;
＿end
＿else begin
＿＿Tab(1);
＿end;
＿if n = nMsg then begin
＿＿Message(i, ' (', n, ')');
＿＿nMsg:= nMsg + MsgStep;
＿end;
end;{WriteForm}

procedure SetOffset;
begin
＿offset[0]:= 1;
＿offset[1]:= 7;
＿offset[2]:= 11;
＿offset[3]:= 13;
＿offset[4]:= 17;
＿offset[5]:= 19;
＿offset[6]:= 23;
＿offset[7]:= 29;
end;{SetOffset}

procedure SetDisOffset;
var
＿i＿:integer;
begin
＿for i:= 0 to 29 do
＿＿disOffset[i]:= -1;
＿disOffset[1]:= 0;
＿disOffset[7]:= 1;
＿disOffset[11]:= 2;
＿disOffset[13]:= 3;
＿disOffset[17]:= 4;
＿disOffset[19]:= 5;
＿disOffset[23]:= 6;
＿disOffset[29]:= 7;
end;{SetDisOffset}

begin{main}
＿t0:= GetTickCount;
＿err:= false;
＿SetOffset;
＿SetDisOffset;
＿InitList;
＿n:= 0;
＿nMsg:= MsgStep; nCr:= CrStep;
＿WriteForm(2);
＿WriteForm(3);
＿WriteForm(5);
＿for k:= 1 to 7 do begin { ふるいにかける(7..30) }
＿＿i:= offset[k];
＿＿if not GetList(i) then begin
＿＿＿WriteForm(i);
＿＿＿j:= i * i;
＿＿＿dj:= 2 * i;
＿＿＿Message('Set List...(', i, ') ', i/Limit*100, '%');
＿＿＿while j <= MaxNum do begin
＿＿＿＿SetList(j, true);
＿＿＿＿j:= j + dj;
＿＿＿end;
＿＿end;
＿end;
＿ii:= 30;
＿repeat { ふるいにかける(31..√MaxNum) }
＿＿for k:= 0 to 7 do begin
＿＿＿i:= ii + offset[k];
＿＿＿if not GetList(i) then begin
＿＿＿＿WriteForm(i);
＿＿＿＿j:= i * i;
＿＿＿＿dj:= 2 * i;
＿＿＿＿Message('Set List...(', i, ') ', i/Limit*100, '%');
＿＿＿＿while j <= MaxNum do begin
＿＿＿＿＿SetList(j, true);
＿＿＿＿＿j:= j + dj;
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until (Limit <= i) | err;
＿repeat { 素数を抽出(√MaxNum..MaxNum) }
＿＿for k:= 0 to 7 do begin
＿＿＿i:= ii + offset[k];
＿＿＿if (i <= MaxNum) & (not GetList(i)) then begin
＿＿＿＿WriteForm(i);
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until (MaxNum <= ii) | err;
＿SysBeep;
＿t:= (GetTickCount - t0);
＿if err then
＿＿Message('Failed!!', ' (', t/60, 'sec)')
＿else
＿＿Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime8);

Prime8の処理時間は下のようになりました。
50,000・・・・・・　2.1秒
100,000 ・・・・・　4.0秒
200,000 ・・・・・　8.0秒
400,000 ・・・・・ 16.0秒
800,000 ・・・・・ 32.2秒
1,000,000 ・・・・ 40.4秒
10,000,000・・・・423.0秒
Prime7よりメモリアクセスに手間がかかってますが、予想ほどは遅くなりませんでした。
Prime6で速度半減したのは、メモリアクセスをサブルーチン化した影響が大きかったようです。
GetList、SetListを展開すればもっと早くなるでしょうが、スクリプトが読みにくくなるのでやりません。
そのような最適化は最後の手段と心得るべきでしょう。

初歩の質問で申し訳ありません。
メッセージウィンドウ内で文章を強制的に改行させることはできるでしょうか。
よろしくお願いいたします。

やべさん、お初です。

マニア認定されて、喜んでいいのか悪いのか（笑）。
確かに実用性は、ないですねぇ。巨大配列とメッセージの出し方の勉強にはなりましたが。

スクリプト実行中は、10秒でも長いと感じます。
画面に何の変化もないと、すぐにフリーズかと疑ってしまいます。
かといって、メッセージを出しすぎるとと実行速度に影響するし、
データ量の大小で変える必要もあったりして、一筋縄ではいきません。
結局は「ケース・バイ・ケース」です。
メッセージ表示の処理をスクリプトの裏で同時に走らせて、カウンタ変数を監視しながら
進捗状況を勝手に表示してくれるような機能があったらなあと思いました。

素数の話はそろそろネタ切れです、書いてるうちに何か思い付くかも知れませんが。

与太郎さん、こんにちは。

なんかマニアックなことをやってますね。
これを見ていて、東大の円周率計算の世界記録を争っている教授のことを思い出しました。
あれも一見、無駄なようですが、科学研究の基盤として役立つと言ってました。

VectorWorksも、アルゴリズムの見直しでレンダリングが100倍速くなりました！とかなればいいですよね...。

Prime6の初期化サブルーチンのメッセージ表示の部分で、10000をRangeに直すのを忘れていたため、
パーセントの値が実際の１／３くらいになっていました。ゴメンナサイ。

Prime6を実行すれば判りますが、最初のほうの計算に実行時間のかなりの部分を費やしています。
その部分を省けば速くなるので、Prime5と同様に、２、３、５を処理しないように改造しました。
また、配列は最初からFalseで初期化されてるみたいなので、InitListをコメントアウトすると20％
くらいの高速化が可能です。

procedure Prime7;
{$ DEBUG}
const
＿MaxNum = 100000;
＿Limit = Trunc(Sqrt(MaxNum));
＿Range = 32768;
＿MsgStep = 1000;
＿CrStep = 20;
var
＿i, ii, j, dj, k, n, nMsg, nCr, t0, t＿:longint;
＿list＿:array[0..MaxNum div Range , 0..Range-1] of boolean;
＿offset＿:array[1..8] of longint;

function GetList(i:longint):boolean;
begin
＿GetList:= list[i div Range, i mod Range];
end;{GetList}

procedure SetList(i:longint; st:boolean);
begin
＿list[i div Range, i mod Range]:= st;
end;{SetList}

procedure InitList;
var
＿iH, iL＿:longint;
begin
＿Message('Inicializing...');
＿for iH:= 0 to MaxNum div Range do begin
＿＿for iL:= 0 to Range-1 do begin
＿＿＿list[iH, iL]:= false;
＿＿end;
＿＿Message('Inicializing...', iH/(MaxNum div Range)*100, '%');
＿end;
end;{InitList}

procedure WriteForm(i:longint);
begin
＿n:= n + 1;
＿Write(i);
＿if n = nCr then begin
＿＿WriteLn;
＿＿nCr:= nCr + CrStep;
＿end
＿else begin
＿＿Tab(1);
＿end;
＿if n = nMsg then begin
＿＿Message(i, ' (', n, ')');
＿＿nMsg:= nMsg + MsgStep;
＿end;
end;{WriteForm}

procedure SetOffset;
begin
＿offset[1]:= 1;
＿offset[2]:= 7;
＿offset[3]:= 11;
＿offset[4]:= 13;
＿offset[5]:= 17;
＿offset[6]:= 19;
＿offset[7]:= 23;
＿offset[8]:= 29;
end;{SetOffset}

begin{main}
＿t0:= GetTickCount;
＿SetOffset;
＿InitList;
＿n:= 0;
＿nMsg:= MsgStep; nCr:= CrStep;
＿WriteForm(2);
＿WriteForm(3);
＿WriteForm(5);
＿for k:= 2 to 8 do begin { ふるいにかける(7..29) }
＿＿i:= offset[k];
＿＿WriteForm(i);
＿＿j:= i * i;
＿＿dj:= 2 * i;
＿＿Message('Set List...(', i, ') ', i/Limit*100, '%');
＿＿while j <= MaxNum do begin
＿＿＿SetList(j, true);
＿＿＿j:= j + dj;
＿＿end;
＿end;
＿ii:= 30;
＿repeat { ふるいにかける(31..√MaxNum) }
＿＿for k:= 1 to 8 do begin
＿＿＿i:= ii + offset[k];
＿＿＿if not GetList(i) then begin
＿＿＿＿WriteForm(i);
＿＿＿＿j:= i * i;
＿＿＿＿dj:= 2 * i;
＿＿＿＿Message('Set List...(', i, ') ', i/Limit*100, '%');
＿＿＿＿while j <= MaxNum do begin
＿＿＿＿＿SetList(j, true);
＿＿＿＿＿j:= j + dj;
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until Limit <= i;
＿repeat { 素数を抽出(√MaxNum..MaxNum) }
＿＿for k:= 1 to 8 do begin
＿＿＿i:= ii + offset[k];
＿＿＿if (i <= MaxNum) & (not GetList(i)) then begin
＿＿＿＿WriteForm(i);
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until MaxNum <= ii;
＿SysBeep;
＿t:= (GetTickCount - t0);
＿Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime7);

Prime7の処理は下のようになりました。
50,000・・・・・・　1.9秒
100,000 ・・・・・　3.6秒
200,000 ・・・・・　7.0秒
400,000 ・・・・・ 13.8秒
800,000 ・・・・・ 27.6秒
1,000,000 ・・・・ 34.7秒
10,000,000・・・・355.2秒
Prime6の半分以下の処理時間になりました。100,000,000までなら約１時間の計算です。
メモリとCPUクロック数が共に数ギガあるのなら、1,000,000,000に挑戦してみるのも一興です。

７以上の素数の処理を省いても、苦労の割には劇的な時間短縮は望めそうにありません。
むしろ、大量に確保した配列の７割以上(22/30)が無駄になっているのが気になります。

１次元配列では65,536個を超える配列は作れないので、今回は２次元配列を使います。
array[0..MaxNum div 32768, 0..32767] of boolean; とすれば、0〜1,073,741,823 までの配列が作れます。
論理型変数が１byteか２byteかによりますが、このときのメモリサイズは１〜２GBです。
目標は100,000,000までなので100〜200MBのメモリが必要ですが、現在のメモリ事情なら問題ないでしょう。
Classic環境ならVWのメモリ割り当てを増やす必要があるかもしれません。

話を簡単にするために、list : array[0..MaxNum div 10000, 0..9999] of boolean; として、
例えば listの125,500番目にTrueを代入すると、list[12, 5500]:= True; となります。
変数を使うなら、i:= 125500; list[i div 10000, i mod 10000]:= True; となります。

procedure Prime6;
{$ DEBUG}
const
＿MaxNum = 100000;
＿Limit = Trunc(Sqrt(MaxNum));
＿Range = 32768;
＿MsgStep = 1000;
＿CrStep = 20;
var
＿i, ii, j, n, nMsg, nCr, t0, t＿:longint;
＿list＿:array[0..MaxNum div Range , 0..Range-1] of boolean;

function GetList(i:longint):boolean;
begin
＿GetList:= list[i div Range, i mod Range];
end;{GetList}

procedure SetList(i:longint; st:boolean);
begin
＿list[i div Range, i mod Range]:= st;
end;{SetList}

procedure InitList;
var
＿iH, iL＿:longint;
begin
＿Message('Inicializing...');
＿for iH:= 0 to MaxNum div Range do begin
＿＿for iL:= 0 to Range-1 do begin
＿＿＿list[iH, iL]:= false;
＿＿end;
＿＿Message('Inicializing...', iH/MaxNum*1000000, '%');
＿end;
end;{InitList}

procedure WritePrime(i:longint);
begin
＿n:= n + 1;
＿Write(i);
＿if n = nCr then begin
＿＿WriteLn;
＿＿nCr:= nCr + CrStep;
＿end
＿else begin
＿＿Tab(1);
＿end;
＿if n = nMsg then begin
＿＿Message(i, ' (', n, ')');
＿＿nMsg:= nMsg + MsgStep;
＿end;
end;{WritePrime}

begin{main}
＿t0:= GetTickCount;
＿InitList;
＿n:= 0;
＿nMsg:= MsgStep; nCr:= CrStep;
＿for i:= 2 to Limit do begin { ふるいにかける }
＿＿if not GetList(i) then begin
＿＿＿WritePrime(i);
＿＿＿j:= i * i;
＿＿＿if i = 2 then
＿＿＿＿ii:= i
＿＿＿else
＿＿＿＿ii:= 2 * i;
＿＿＿Message('Set List...(', i, ') ', i/Limit*100, '%');
＿＿＿while j <= MaxNum do begin
＿＿＿＿SetList(j, true);
＿＿＿＿j:= j + ii;
＿＿＿end;
＿＿end;
＿end;
＿for i:= Limit+1 to MaxNum do begin { 素数を抽出 }
＿＿if not GetList(i) then begin
＿＿＿WritePrime(i);
＿＿end;
＿end;
＿SysBeep;
＿t:= (GetTickCount - t0);
＿Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime6);

Prime6の処理は下のようになりました。
50,000 ・・・・ 3.6秒
100,000・・・・ 7.1秒
200,000・・・・13.9秒
400,000・・・・30.3秒
800,000・・・・60.5秒
divとmodの計算をするため、Prime5の半分くらいの処理速度になっています。
PentiamIII/600MHzだと100,000,000までの計算に２時間近くかかりますが、
速いマシンなら30分以下で出来るでしょう。出力ファイルは数十MBになります。
実際に100,000,000まで計算すると、十〜数十分間は
'Set List...(2) 0.0632511068943706%'の表示のままVWが固まったようになりますが、
フリーズではないので御心配なく。（多分...動いてます、メモリが十分あれば）

素数の判定には「エラストテネスのふるい」という方法があります。
数列から素数の倍数を消してゆき、素数だけを残す方法です。

例として90以下の素数を書き出してみます。
最初に１〜90までの数列を用意します。
１　２　３ ４ ５ ６ ７ ８ ９ 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
31　32　33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
61　62　63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
１は素数ではないので消します。最初の素数は２です。
／ [２] ３ ４ ５ ６ ７ ８ ９ 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
31　32　33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
61　62　63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
２の倍数を消します。
／ [２] ３ ／ ５ ／ ７ ／ ９ ／ 11 ／ 13 ／ 15 ／ 17 ／ 19 ／ 21 ／ 23 ／ 25 ／ 27 ／ 29 ／
31　／　33 ／ 35 ／ 37 ／ 39 ／ 41 ／ 43 ／ 45 ／ 47 ／ 49 ／ 51 ／ 53 ／ 55 ／ 57 ／ 59 ／
61　／　63 ／ 65 ／ 67 ／ 69 ／ 71 ／ 73 ／ 75 ／ 77 ／ 79 ／ 81 ／ 83 ／ 85 ／ 87 ／ 89 ／
２番目の素数は３です。９以上の３の倍数を消します。
／ [２][３]／ ５ ／ ７ ／ ／ ／ 11 ／ 13 ／ ／ ／ 17 ／ 19 ／ ／ ／ 23 ／ 25 ／ ／ ／ 29 ／
31　／　／ ／ 35 ／ 37 ／ ／ ／ 41 ／ 43 ／ ／ ／ 47 ／ 49 ／ ／ ／ 53 ／ 55 ／ ／ ／ 59 ／
61　／　／ ／ 65 ／ 67 ／ ／ ／ 71 ／ 73 ／ ／ ／ 77 ／ 79 ／ ／ ／ 83 ／ 85 ／ ／ ／ 89 ／
３番目の素数は５です。25以上の５の倍数を消します。
／ [２][３]／[５]／ ７ ／ ／ ／ 11 ／ 13 ／ ／ ／ 17 ／ 19 ／ ／ ／ 23 ／ ／ ／ ／ ／ 29 ／
31　／　／ ／ ／ ／ 37 ／ ／ ／ 41 ／ 43 ／ ／ ／ 47 ／ 49 ／ ／ ／ 53 ／ ／ ／ ／ ／ 59 ／
61　／　／ ／ ／ ／ 67 ／ ／ ／ 71 ／ 73 ／ ／ ／ 77 ／ 79 ／ ／ ／ 83 ／ ／ ／ ／ ／ 89 ／
４番目の素数は７です。49以上の７の倍数を消します。
／ [２][３]／[５]／[７]／ ／ ／ 11 ／ 13 ／ ／ ／ 17 ／ 19 ／ ／ ／ 23 ／ ／ ／ ／ ／ 29 ／
31　／　／ ／ ／ ／ 37 ／ ／ ／ 41 ／ 43 ／ ／ ／ 47 ／ ／ ／ ／ ／ 53 ／ ／ ／ ／ ／ 59 ／
61　／　／ ／ ／ ／ 67 ／ ／ ／ 71 ／ 73 ／ ／ ／ ／ ／ 79 ／ ／ ／ 83 ／ ／ ／ ／ ／ 89 ／
５番目の素数は11です。11の２乗は90より大きいので、これ以上消す必要はありません。
残った数字、
[2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89]
が90以下の素数です。

２〜ｎまでの論理型変数の配列を使えば、スクリプトを書くのに困難はありません。
ただ、VectorScriptでは配列が-32,768〜+32,767の範囲でしか取れないので、
とりあえずはMaxNumを50,000にしておきます。

procedure Prime5;
{$ DEBUG}
const
MaxNum = 50000;
Offset = -32768;
Limit = Trunc(Sqrt(MaxNum));
MsgStep = 1000;
CrStep = 10;
var
i, ii, j, n, nMsg, nCr, t0, t:longint;
list:array[Offset+2..Offset+MaxNum] of boolean;

procedure InitList;
var
i:longint;
begin
for i:= 2 to MaxNum do begin
list[Offset+i]:= false;
end;
end;{InitList}

procedure WritePrime(i:longint);
begin
n:= n + 1;
Write(i);
if n = nCr then begin
WriteLn;
nCr:= nCr + CrStep;
end
else begin
Tab(1);
end;
if n = nMsg then begin
Message(i, ' (', n, ')');
nMsg:= nMsg + MsgStep;
end;
end;{WritePrime}

begin{main}
t0:= GetTickCount;
InitList;
n:= 0;
nMsg:= MsgStep; nCr:= CrStep;
for i:= 2 to Limit do begin { ふるいにかける }
if not list[Offset+i] then begin
WritePrime(i);
j:= i * i;
if i = 2 then
ii:= i
else
ii:= 2 * i;
while j <= MaxNum do begin
list[Offset+j]:= true;
j:= j + ii;
end;
end;
end;
for i:= Limit+1 to MaxNum do begin { 素数を抽出 }
if not list[Offset+i] then begin
WritePrime(i);
end;
end;
SysBeep;
t:= (GetTickCount - t0);
Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime5);

Prime5の処理は下のようになりました。
25,000 ・・・・0.9秒
50,000 ・・・・1.9秒
このアルゴリズムが優れている点は、実行時間がｎにほぼ比例していることです。
大きな配列さえ使えれば100,000,000まででも１時間くらいで計算できると思います。

Prime3では 6n+(-1, 1) だけ計算して、２と３の倍数を最初から除外していますが、
これを一般化すると下のようになります。

２の倍数を除外…(2)n+[1]
３の倍数も除外…(2x3)n+[1, 5]
５の倍数も除外…(2x3x5)n+[1, 7, 11, 13, 17, 19, 23, 29]
７の倍数も除外…(2x3x5x7)n+[1, 11, 13, 17, 19, 23, 29...181, 191, 193, 197, 199]
11の倍数も除外…(2x3x5x7x11)n+[1, 13, 17, 19, 23, 29...2273, 2281, 2287, 2293, 2297, 2309]

計算量は下のようになります。

２の倍数を除外…1/2 = 50%
３の倍数も除外…2/6 = 33.3%
５の倍数も除外…8/30 = 26.7%
７の倍数も除外…42/210 = 20%
11の倍数も除外…339/2310 = 14.7%

オフセット値を配列に入れるにしても、８個ぐらいなら直接入れてもいいですが、
42個や339個となると、素数は自動生成させたほうが良さそうです。
とりあえずは２と３と５の倍数だけ取り除きます。

ある数ｉがｊで割り切れたとき、ｊ自身が素数でないならｊは素数ｐの倍数ですから、
ｊで割ってみる以前にｐで割り切れて素数ではないと判定されているはずです。
ですからｊは素数だけで良いことになります。
要するに i mod j のｊは、ｉの平方根以下の素数だけとなります。
素数は小さい順に見つけてゆきますから、MaxNumの平方根までは素数を見つけたらに配列に入れて、
後の計算で参照できるようにします。
素数の配列サイズは多めに取っておきます。

procedure Prime4;
{$ DEBUG}
const
＿MaxNum = 100000;
＿SqrtMaxNum = round(Sqrt(MaxNum));
＿MaxArray = 1250;
＿MsgStep = 100;
＿CrStep = 10;
var
＿i, ii, k, nP, nMsg, nCr, t0, t＿:longint;
＿prime＿:array[0..MaxArray] of longint;
＿offset＿:array[1..8] of longint;

function IsPrime(i:longint):boolean;
var
＿j, k＿:longint;
＿result＿:boolean;
begin
＿result:= true;
＿j:= 1;
＿k:= Trunc(Sqrt(i));
＿while result & (prime[j] <= k) do begin
＿＿if (i mod prime[j]) = 0 then begin
＿＿＿result:= false;
＿＿end;
＿＿j:= j + 1;
＿end;
＿IsPrime:= result;
end;{IsPrime}

procedure WriteForm(i:longint);
begin
＿nP:= nP + 1;
＿Write(i);
＿if nP = nCr then begin
＿＿WriteLn;
＿＿nCr:= nCr + CrStep;
＿end
＿else begin
＿＿Tab(1);
＿end;
＿if nP = nMsg then begin
＿＿Message(i, ' (', nP, ')');
＿＿nMsg:= nMsg + MsgStep;
＿end;
end;{WriteForm}

procedure SetOffset;
begin
＿offset[1]:= 1;
＿offset[2]:= 7;
＿offset[3]:= 11;
＿offset[4]:= 13;
＿offset[5]:= 17;
＿offset[6]:= 19;
＿offset[7]:= 23;
＿offset[8]:= 29;
end;{SetOffset}

begin{main}
＿t0:= GetTickCount;
＿SetOffset;
＿nP:= 0;
＿nMsg:= MsgStep; nCr:= CrStep;
＿WriteForm(2); prime[nP]:= 2;
＿WriteForm(3); prime[nP]:= 3;
＿WriteForm(5); prime[nP]:= 5;
＿WriteForm(7); prime[nP]:= 7;
＿WriteForm(11); prime[nP]:= 11;
＿WriteForm(13); prime[nP]:= 13;
＿WriteForm(17); prime[nP]:= 17;
＿WriteForm(19); prime[nP]:= 19;
＿WriteForm(23); prime[nP]:= 23;
＿WriteForm(29); prime[nP]:= 29;
＿ii:= 30;
＿repeat
＿＿for k:= 1 to 8 do begin
＿＿＿i:= ii+offset[k];
＿＿＿if IsPrime(i) then begin
＿＿＿＿WriteForm(i);
＿＿＿＿prime[nP]:= i;{ 素数を配列に追加 }
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until SqrtMaxNum < i;
＿prime[nP+1]:= MaxNum;
＿repeat
＿＿for k:= 1 to 8 do begin
＿＿＿i:= ii+offset[k];
＿＿＿if IsPrime(i) then begin
＿＿＿＿WriteForm(i);
＿＿＿end;
＿＿end;
＿＿ii:= ii + 30;
＿until MaxNum < i;
＿SysBeep;
＿t:= (GetTickCount - t0);
＿Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime4);

Prime4の処理時間は下のようになりました。
50,000 ・・・・　5.6秒
100,000・・・・ 13.3秒
200,000・・・・ 31.3秒
400,000・・・・ 75.1秒
800,000・・・・183.0秒
100,000,000までだと１日くらいでしょうか。
期待したほどは速くなりませんでした。

２と３の倍数は当然素数ではないので、本来チェックする必要はありません。
下のように２と３の倍数に括弧を付けてみると、ある法則が見えてきます。

(2), (3), (4), 5, (6), 7, (8), (9), (10), 11, (12), 13, (14), (15), (16), 17, (18), 19, (20), (21)...

どうやら６の倍数の前後の数字（6n-1, 6n+1）だけチェックすればいいようです。

procedure Prime3;
{$ DEBUG}
const
MaxNum = 100000;
MsgStep = 100;
CrStep = 10;
var
i, ii, n, nMsg, nCr, t0, t:longint;

function IsPrime(i:longint):boolean;
var
j, jj, k:longint;
result:boolean;
begin
result:= true;
j:= 3;
if (i mod j) = 0 then begin
result:= false;
end;
k:= Trunc(Sqrt(i));
jj:= 1;
while result & (j < k) do begin
j:= 6*jj-1;
if (i mod j) = 0 then begin
result:= false;
end;
j:= 6*jj+1;
if (i mod j) = 0 then begin
result:= false;
end;
jj:= jj + 1;
end;
IsPrime:= result;
end;{IsPrime}

procedure WriteForm(i:longint);
begin
n:= n + 1;
Write(i);
if n = nCr then begin
WriteLn;
nCr:= nCr + CrStep;
end
else begin
Tab(1);
end;
if n = nMsg then begin
Message(i, ' (', n, ')');
nMsg:= nMsg + MsgStep;
end;
end;{WriteForm}

begin{main}
t0:= GetTickCount;
n:= 0;
WriteForm(2);
WriteForm(3);
nMsg:= MsgStep; nCr:= CrStep;
ii:= 6;
while ii < MaxNum do begin
i:= ii-1;
if IsPrime(i) then begin
WriteForm(i);
end;
i:= ii + 1;
if IsPrime(i) then begin
WriteForm(i);
end;
ii:= ii + 6;
end;
SysBeep;
t:= (GetTickCount - t0);
Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime3);

Prime3の処理時間は下のようになりました。
50,000 ・・・・　6.3秒
100,000・・・・ 15.5秒
200,000・・・・ 38.9秒
400,000・・・・ 99.6秒
800,000・・・・257.3秒
100,000,000までの計算だと２日くらいでしょうか。

Prime1の処理時間は下のようになりました。
2,500 ・・・・　6.3秒
5,000 ・・・・ 22.4秒
10,000・・・・ 81.8秒
20,000・・・・305.6秒
概算では1,000,000まで計算するのに一週間程かかります。
100,000,000まで計算すると100年以上になってしまうので、
大幅なスピードアップが必要です。

まず、２以外の偶数は素数ではない（必ず２で割り切れる）ので、
奇数のみを対象にすれば計算は半分になります。
また、ｊの範囲は３..ｉ-１でなく３..√(ｉ)で良く、
これまた偶数は除外できます。
これでかなり速くなりますので、MaxNumは100,000にしときます。

procedure Prime2;
{$ DEBUG}
const
MaxNum = 100000;
MsgStep = 100;
CrStep = 10;
var
i, n, nMsg, nCr, t0, t:longint;

function IsPrime(i:longint):boolean;
var
j, k:longint;
result:boolean;
begin
result:= true;
j:= 3;
k:= Trunc(Sqrt(i));
while result & (j <= k) do begin
if (i mod j) = 0 then begin
result:= false;
end;
j:= j + 2;
end;
IsPrime:= result;
end;{IsPrime}

procedure WriteForm(i:longint);
begin
n:= n + 1;
Write(i);
if n = nCr then begin
WriteLn;
nCr:= nCr + CrStep;
end
else begin
Tab(1);
end;
if n = nMsg then begin
Message(i, ' (', n, ')');
nMsg:= nMsg + MsgStep;
end;
end;{WriteForm}

begin{main}
t0:= GetTickCount;
WriteForm(2);
i:= 3; n:= 1; nMsg:= MsgStep; nCr:= CrStep;
while i <= MaxNum do begin
if IsPrime(i) then begin
WriteForm(i);
end;
i:= i + 2;
end;
SysBeep;
t:= (GetTickCount - t0);
Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime2);

Prime2の処理時間は下のようになりました。
50,000 ・・・・　8.8秒
100,000・・・・ 22.5秒
200,000・・・・ 56.3秒
400,000・・・・143.2秒
これでも100,000,000までの計算には２ヶ月くらいかかりそうです。

プログラム言語の演習問題の定番に「素数を書き出す」というのがあります。
素数とは、１とその数自身でしか割り切れない、１以外の自然数です。
2, 3, 5, 7, 11, 13, 17, 19, 23, 29...と永遠に続きますが、
ここでは100,000,000までの素数を全部書き出したいと思います。
現実に何の役に立つのかと問われれば、おそらく何の役にも立たないですが、
しばらく付き合ってくださいませ。＞皆様

素数を書き出すスクリプトを何の工夫もせずに書くと下のようになります。

ある数ｉをｊ（範囲=２..ｉ-１）で割って、
最後まで割り切れなかったらｉは素数なのでファイルに書き出します。
結果は「Output.txt」または「Output File」に書き出されます。
とても遅いスクリプトなので、MaxNumは10,000にしています。

procedure Prime1;
{$ DEBUG}
const
MaxNum = 10000;
MsgStep = 10;
CrStep = 10;
var
i, j, n, nMsg, nCr, t0, t:longint;
result:boolean;

function IsPrime(i:longint):boolean;
var
j, k:longint;
result:boolean;
begin
result:= true;
j:= 2;
while result & (j < i) do begin
if (i mod j) = 0 then begin
result:= false;
end;
j:= j + 1;
end;
IsPrime:= result;
end;{IsPrime}

procedure WriteForm(i:longint);
begin
n:= n + 1;
Write(i);
if n = nCr then begin
WriteLn;
nCr:= nCr + CrStep;
end
else begin
Tab(1);
end;
if n = nMsg then begin
Message(i, ' (', n, ')');
nMsg:= nMsg + MsgStep;
end;
end;{WriteForm}

begin{main}
t0:= GetTickCount;
n:= 0; nMsg:= MsgStep; nCr:= CrStep;
for i:= 2 to MaxNum do begin
if IsPrime(i) then begin
WriteForm(i);
end;
end;
SysBeep;
t:= (GetTickCount - t0);
Message('Finish! 2 - ', MaxNum, ' (', t/60, 'sec)');
end;
Run(Prime1);

数が大きくなるにつれて実行速度が激減してゆきます。
100,000,000どころか1,000,000まで計算する気にもなりません。

Ａ＆Ａの２月の「今月のトピック」に、名前のリストを調べてハッチングのリストを作るというのがあります。
ハッチングだけでなく、シンボル定義、シンボルフォルダ、コマンド、コマンドパレット、レイヤ、レコード定義、
ワークシート、クラス定義も必ず名前が付いているので、名前のリストから検索することが出来ます。
ただし、レイヤ名だけは名前のリストに入っていません。

MC6くらいまではクラス名とレコード名が同じでも良かったのに、バージョンアップで名前の重複が許されなくなりましたが、
全ての名前（レイヤ名を除く）を一元管理するように変更されていたわけです。

procedure test;
{ 名前とオブジェクト・タイプをファイルに書き出す }
var
i:longint;
begin
for i:= 1 to NameNum do begin
Write(NameList(i));
Tab(1);
WriteLn(GetType(GetObject(NameList(i))));
end;
end;
Run(test);

Ａ＆ＡのサンプルはIndex2Nameを使ってますが、NameListでも同じです。
VW8でName2Index関数が追加されたので、整合性のためにIndex2Namも追加されたのでしょう。
ある名前が未使用かどうかを if GetObject(name) = nil then で調べているのですが、
if Name2Index(name) = 0 then と書き換え可能です。
ただし、GetObjectで調べた場合はレイヤまで調べてくれますから、レイヤ名の重複を調べるならGetObjectで良いようです。

さて、ここで問題ですが、図形にレイヤと同じ名前をつけた場合、GetObjectでどっちのハンドルが返って来るでしょうか？

与太郎さん　ありがとうございます。
仕事が忙しく、今、確認させていただきました。
助かります。
「最上位の図形」とか、本当にマニュアルの説明には惑わされますね。

アクティブクラスはNameClassで設定します。
Layerと同様に、指定したクラスが存在しなければ新しく作成されます。

NameClassの説明は「直後に作成される図形に、指定したクラスを設定します。」となっていますが、
原文ではアクティブクラスに設定するという表現になっています。
また、クラス名の文字数制限についても述べています。
Reference Manualは原文も読んだほうがいいようです。

それから、スクリプトで疑問があったとき、VWで描いてVectorScript形式で書き出して眺めてみると、
答えが見つかることも多いですよ。

お世話になります。
早速ですが、『Layer』でアクティブレイヤを変更することができますが、
アクティブクラスの変更はどのようにすればできるのでしょうか。
よろしくお願いいたします。

タイトルにまともに答えると「古いバージョンでは32KBまで」という答えが返ってきますので、
次回からは「ダイアログのアイテム数の制限は？」のような、質問内容に合ったタイトルにしてくださいね。

＞1/3位しか表示されません
この時点でエラーや警告のメッセージは出てないということですよね？
エラーも警告も出ないのにアイテムが表示されないとしたら、開発者もこの不具合に気付いてないと思うので、
OS、VWのバージョン他、アイテムの種類や症状を明記の上、Ａ＆Ａに問い合わせてはいかがでしょうか。

断定できませんが、書き込みを読むかぎり、メモリ不足が原因だと思います。
OSやVWのバージョンは書いてないのにメモリの搭載量だけは書かれているということは、
御自身もメモリの問題だと疑っているのでしょう。

＞一つのダイアログに５００アイテム
20列×25行とか10列×50行でアイテムが並んでるようなものを想像してしまいました。
実行速度のほうはどうなんでしょうか。
「アイテム＝画像」だとしたらメモリも相応に消費すると思います。

取り消し回数をゼロに設定すると、その分メモリーを余計に使えるのでエラーを回避できることもあります。

＞VectorScriptを実行するのにどのような制限があるか教えてください。
そういう資料があるなら私も知りたいです。
「メモリの許すかぎり」という答えが返ってきそうですが...

コンパイルに成功したプログラム（ソースコードのファイルサイズ１５４KB）を実行したんですが、結果が途中で終わってしまします。

具体的な現象としては、
?一つのダイアログに５００アイテムを定義したダイアログを表示させようとしたところ
1/3位しか表示されません。（実装メモリ１２８ＭＢ）

?．?のプログラムを（実装メモリ５１２ＭＢ）のマシン上で実行したところ全て表示されます。

VectorScriptを実行するのにどのような制限があるか教えてください。

　これって案外、勘違いしそうなんですよ...。本体の説明とVSでの説明が微妙？に違う表
現であることが多かったりします。
＞毎日楽しみにしてます。
いや、毎日は書けません...。ぼちぼち、やりますので。

VectorScript Function Referenceには「最上位の図形」、「最下位の図形」と書いてあるので、
「最上位の図形」が一番上（最前面）だと考えてしまいますが、これは間違いです。
原文ではFirst、Lastなので、「最初の図形」、「最後の図形」と覚えておいたほうがいいと思います。
つまり手で描くときのように、「最初の図形」が最背面、「最後の図形」が最前面になるわけです。
FSActLayer、LSActLayer等の頭文字のＦとＬをFirst、Lastの略と覚えとけば間違いないでしょう。

FSActLayerのＦがForegroundの略だと思っていた人はいませんか？

＞石男さん
「VectorScriptの部屋」開設、おめでとうございます。毎日楽しみにしてます。
ハンドルと図形の関係は、図で説明すると「最上位の図形」が一番上ではなく一番下の図形だとい
うことが一目瞭然ですね。

ここには画像が貼れないので、テキストで作った説明図を貼ってみます。
ハンドル接続（取得）の説明図です。
（等幅フォントでないと表示が崩れます。）
この図では一番上（Object-1）が最背面、一番下（Object-12）が最前面の図形になります。
NextObjectだけでは全ての図形にはアクセスできないことが解ると思います。

.　 　 　 　 【Nil】 　 　 　 　 　 　 　 　 　 【Nil】
.　 　 　 　 　↑ 　 　 　 　 　 　 　 　 　 　 　↑
.　 　PrevLayer│　 　 　 　 　 　 　 　 　PrevObj│
.　 　 　 　 　│ 　 　 　 　 　 　 　 　 　 　 　│
.FLayer─→【Layer-1】────┬─FInLayer─→【Object-1】←─FObject (First Object)
.　 　 　 　 　↑│　 　 　 　│　 　 　 　 　 　 ↑│
.　 　 　 　 　││　 　 　 　│　 　 　 　PrevObj││NextObj
.　 　PrevLayer││NextLayer　│　 　 　 　 　 　 │↓
.　 　 　 　 　││　 　 　 　│　 　 　 　 　【Object-2】
.　 　 　 　 　│↓　 　 　 　│　 　 　 　 　 　 ↑│
. 　 　 　 【Layer-2】　 　 　│　 　 　 　PrevObj││NextObj
.　 　 　 　 　↑│　 　 　 　│　 　 　 　 　 　 │↓
.　 　 　 　 　││　 　 　 　└─LInLayer─→【Object-3】
.　 　PrevLayer││NextLayer　 　 　 　 　 　 　 　 │
.　 　 　 　 　││ 　 　 　 　 　 　 　 　 　 　 　│NextObj
.　 　 　 　 　│↓ 　 　 　 　 　 　 　 　 　 　 　↓
. 　 　 　 【Layer-3】　 　 　 　 　 　 　 　 　【Nil】
.　 　 　 　 　↑│
.　 　 　 　 　││　 　 　 　 　 　 　 　 　 　【Nil】
.　 　PrevLayer││NextLayer 　 　 　 　 　 　 　 ↑
.　 　 　 　 　││ 　 　 　 　 　 　 　 　PrevObj│
.　 　 　 　 　│↓ 　 　 　 　 　 　 　 　 　 　 │
.ActLayer→【Layer-4】────┬─FInLayer─→【Object-4】←FActLayer 　 　 　 　 【Nil】
.　 　 　(Active Layer) 　 　 │　 　 　 　 　 　 ↑│ 　 　 　 　 　 　 　 　 　 　↑
.　 　 　 　 　↑│　 　 　 　│　 　 　 　PrevObj││NextObj 　 　 　 　 　 PrevObj│
.　 　PrevLayer││NextLayer　│　 　 　 　 　 　 │↓ 　 　 　 　 　 　 　 　 　 　│
.　 　 　 　 　││　 　 　 　│　 　 　 　 　【Object-5】────FInGroup──→【Object-6】
.　 　 　 　 　│↓　 　 　 　│ 　 　 　 　 　 (Group)　 　 　 　 　 　 　 　 　 　↑│
. 　 　 　 【Layer-5】　 　 　│　 　 　 　 　 　 ↑│　 　 　 　 　 　 　 　PrevObj││NextObj
.　 　 　 　 　↑│　 　 　 　│　 　 　 　PrevObj││NextObj　 　 　 　 　 　 　 　│↓
.　 　 　 　 　││　 　 　 　│　 　 　 　 　 　 │↓　 　 　 　 　 　 　 　 　【Object-7】
.　 　PrevLayer││NextLayer　└─LInLayer─→【Object-9】←LActLayer　 　 　 　 　 ↑│
.　 　 　 　 　││　 　 　 　 　 　 　 　 　 　 　 │　 　 　 　 　 　 　 　PrevObj││NextObj
.　 　 　 　 　│↓　 　 　 　 　 　 　 　 　 　 　 │NextObj　 　 　 　 　 　 　 　│↓
. 　 　 　 【Layer-6】　 　 　 　 　 　 　 　 　 　 ↓　 　 　 　 　 　 　 　 　【Object-8】
.　 　 　 　 　↑│　 　 　 　 　 　 　 　 　 　【Nil】 　 　 　 　 　 　 　 　 　 　 │
.　 　 　 　 　││ 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 │NextObj
.　 　PrevLayer││NextLayer　 　 　 　 　 　 　【Nil】 　 　 　 　 　 　 　 　 　 　 ↓
.　 　 　 　 　││ 　 　 　 　 　 　 　 　 　 　 ↑　 　 　 　 　 　 　 　 　 　 【Nil】
.　 　 　 　 　││ 　 　 　 　 　 　 　 　PrevObj│
.　 　 　 　 　│↓ 　 　 　 　 　 　 　 　 　 　 │
.LLayer─→【Layer-7】────┬─FInLayer─→【Object-10】
. 　 　 　 　 　 │　 　 　 　│　 　 　 　 　 　 ↑│
. 　 　 　 　 　 │　 　 　 　│　 　 　 　PrevObj││NextObj
. 　 　 　 　 　 ↓　 　 　 　│　 　 　 　 　 　 │↓
.　 　 　 　 【Nil】 　 　 　 │ 　 　 　 　 　【Object-11】
.　 　 　 　 　 　 　 　 　 　│　 　 　 　 　 　 ↑│
.　 　 　 　 　 　 　 　 　 　│　 　 　 　PrevObj││NextObj
.　 　 　 　 　 　 　 　 　 　│　 　 　 　 　 　 │↓
.　 　 　 　 　 　 　 　 　 　└─LInLayer─→【Object-12】←─LObject (Last Object)
. 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　│
. 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　│NextObj
. 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　↓
.　 　 　 　 　 　 　 　 　 　 　 　 　 　 　 　【Nil】

年末用に準備してましたが間に合わなかったので、新年の挨拶にさせていただきました。

procedure HappyNewYear;
{$ DEBUG}
const
num = 1500;
var
txt, criteria:string;
lng, r:real;
px, py:array[0..num+15] of real;
i, j, n:integer;
hL, hAL:handle;

procedure DoPoly(h:handle);
var
lng, dL, k:real;
nP, nL, iP, iL:integer;
x, y, l:array[0..30000] of real;
begin
nL:= GetVertNum(h);
l[0]:= 0;
for iL:= 1 to nL do begin
GetPolyPt(h, iL, x[iL-1], y[iL-1]);
end;
GetPolyPt(h, 1, x[nL], y[nL]);
for iL:= 1 to nL do begin
l[iL]:= l[iL-1] + Distance(x[iL-1], y[iL-1], x[iL], y[iL]);
end;
nP:= Round(l[nL]/r/2);
dL:= l[nL] / nP;
iL:= 1;
lng:= 0;
for iP:= 1 to nP do begin
while (l[iL] < lng) & (iL < nL) do begin
iL:= iL + 1;
end;
if lng <= l[iL] then begin
k:= (lng-l[iL-1])/(l[iL]-l[iL-1]);
px[iP+I]:= x[iL-1] + (x[iL]-x[iL-1]) * k;
py[iP+I]:= y[iL-1] + (y[iL]-y[iL-1]) * k;
lng:= lng + dL;
end
end;
i:= i + nP;
end;{DoPoly}

procedure ChangeColor(col:integer);
var
hC:handle;
ii, i:integer;
begin
ii:= num div 25;
i:= ii;
hC:= FActLayer;
while hC <> nil do begin
SetFillFore(hC, Col);
SetPenFore(hC, Col);
i:= i - 1;
if i < 0 then begin
i:= ii;
ReDrawAll;
end;
hC:= NextObj(hC);
end;
ReDrawAll;
Wait(1);
end;{ChangeColor}

procedure DeleteCircles;
var
hC, hE:handle;
ii, i:integer;
begin
ii:= num div 100;
i:= ii;
hC:= FActLayer;
while hC <> nil do begin
DelObject(hC);
i:= i - 1;
if i < 0 then begin
i:= ii;
ReDraw;
end;
hC:= FActLayer;
end;
ReDrawAll;
end;{DeleteCircles}

begin{main}
PushAttrs;
hAL:= ActLayer;
txt:= Concat(Chr(130), Chr(160), Chr(130), Chr(175), Chr(130), Chr(220), Chr(130), Chr(181));
txt:= Concat(txt, Chr(130), Chr(196), Chr(13), Chr(130), Chr(168), Chr(130), Chr(223));
txt:= Concat(txt, Chr(130), Chr(197), Chr(130), Chr(198), Chr(130), Chr(164));
criteria:= Concat('L=',Chr(39), txt, Chr(39));
Layer(txt);
SetVCenter(0, 0);
SetZoom(1);
DSelectAll;
TextOrigin(0, 0);
TextFont(GetFontID('ＭＳ 明朝'));
TextSize(96);
TextJust(2);
TextVerticalAlign(3);
CreateText(txt);
PenSize(0);
DoMenuTextByName('TrueType To PolyLine', 0);
UnGroup;
DoMenuTextByName('Convert to Polygons', 0);
lng:= Perim(criteria);
r:= lng / num / 2;
i:= 0;
ForEachObject(DoPoly, criteria);
DeleteObjs;
SetZoom(100);
n:= i;
PenSize(1);
FillPat(2);
for i:= n downto 1 do begin
j:= 1 + Round(Random * (i-1));
if i <> j then begin
px[0]:= px[i]; px[i]:= px[j]; px[j]:= px[0];
py[0]:= py[i]; py[i]:= py[j]; py[j]:= py[0];
end;
Arc(px[i]-r, py[i]+r, px[i]+r, py[i]-r, 0, 360);
SetDSelect(LSActLayer);
ReDraw;
end;
ReDrawAll;
ChangeColor(7);
ChangeColor(4);
ChangeColor(2);
ChangeColor(6);
ChangeColor(5);
ChangeColor(255);
DeleteCircles;
hL:= ActLayer;
Layer(GetLName(hAL));
DelObject(hL);
PopAttrs;
end;
Run(HappyNewYear);