Script談話室バックナンバー2010

丸付き番号を描くスクリプト(4)    与太郎
Mon Dec 27 9:39:58 2010

2バイト文字対応版もフルで書いときます。

procedure MakeNumber4;
{ 丸付き番号を描く(シンボル版-全角文字) }
{$ DEBUG}
const
__WrkSheet = 'Number-Def';
__ParameterRec = 'Number-Rec';
__ClassName = '番号';
__MaxTextLength = 3; { 最大文字数 }
__TxFont = 'MS ゴシック';
__Center = 2;
__VertCenter = 3;
__DefaultText = 'A';
__DefaultStep = 1;
__DefaultDia = 5{m/m};
__DefaultPoly = 0; { 多角形の頂点の数= -9..-3, 0, 3..9 }
__Red = 15;
__Black = 255;
__PenWidth = 6; { (mil) }
__MaskSize = 1.1; { マスクの倍率 }
__MarkerStyle = 13; { 始点に黒丸 }
__MarkerSize = 0.04; { (inch) }
__MarkerAngle = 0; { (degree) }
__WSTextSize = 12;
__
var
__result__:boolean;
__symNm__:string;
__x0, y0, x1, y1, x2, y2, d, r, r2, scl__:real;
__txt__:string;
__keta, step, n__:integer;
__frac, dsAcc__:longint;
__format__:integer;
__upi__:real;
__uMark, sqUMark__:string;
__
procedure WriteDef(s: string); { 初期値をWSに書き込む }
__var
____h__:handle;
____f__:integer;
__begin
____TextSize(WSTextSize);
____h:= GetObject(WrkSheet);
____SelectSS(h);
____SprdFormat(1, 0, '', '');
____LoadCell(1, 2, s);
____LoadCell(1, 1, 'Index =');
__end;{WriteDef}
__
procedure SetDef(var s:string; var st:integer; var d:real; var n:integer);
{ 初期値、増減分、直径、多角形の頂点の数を設定する }
__const
____F = 3; { 直径の少数点以下桁数 }
__var
____h__:handle;
__begin
____h:= GetObject(WrkSheet);
____if h = nil then begin
______s:= StrDialog('Index =', DefaultText);
______st:= RealDialog('Step =', Num2Str(0, DefaultStep));
______d:= RealDialog('Dia(m/m) =', Num2Str(F, DefaultDia));
______n:= RealDialog('N(0:円) =', Num2Str(0, DefaultPoly));
______NewSprdSheet(WrkSheet, 0, 0, 4, 2, false, true);
______TextSize(WSTextSize);
______SprdFormat(1, 0, '', '');
______LoadCell(1, 1, 'Index ='); LoadCell(1, 2, s);
______LoadCell(2, 1, 'Step ='); LoadCell(2, 2, Num2Str(0, st));
______LoadCell(4, 1, 'N(0:円) ='); LoadCell(4, 2, Num2Str(0, n));
______SprdFormat(1, f, '', '');
______LoadCell(3, 1, 'Dia(m/m) ='); LoadCell(3, 2, Num2Str(F, d));
______h:= GetObject(WrkSheet);
____end
____else begin
______s:= GetCellStr(h, 1, 2);
______st:= GetCellNum(h, 2, 2);
______d:= GetCellNum(h, 3, 2);
______n:= GetCellNum(h, 4, 2);
____end;
____if (abs(n) < 3) | (9 < abs(n)) then begin
______n:= 0;
______SelectSS(h);
______SprdFormat(1, 0, '', '');
______LoadCell(4, 2, Num2Str(0, n));
____end;
__end;{SetDef}
__
procedure DrawPoly(x, y:real; r:real; nP:integer);
__var
____i, n__:integer;
____q, a__:real;
__begin
____if nP=0 then
______Oval(x - r, y - r, x + r, y + r)
____else begin
______n:= Abs(nP);
______q:= r / Cos(Deg2Rad(180/n));
______q:= q * Sqrt(pi / n / Tan(Deg2Rad(180/n)));
______a:= 90;
______case nP of
________-9, -7, -5, -3, 4, 6, 8:
__________a:= a + 180/n;
______end;
______ClosePoly;
______BeginPoly;
______for i:= 1 to n do begin
________AddPoint(x + q*cos(Deg2Rad(a)), y + q*sin(Deg2Rad(a)));
________a:= a + 360/n;
______end;
______EndPoly;
____end;
__end;{DrawPoly}

procedure MakeSymbol(name:string; r, r2, scl:real; n:integer); { シンボルを定義する }
__var
____keta__:integer;
____
__procedure NewText(keta:integer; r:real); { Record Fieldに連結した文字を作る }
____var
______i__:integer;
______txtSize__:real;
______s__:string;
____begin
______s:= '';
______for i:= 1 to keta do
________s:= Concat(s, '0');
______txtSize:= 12 * r * 650 / ((scl * upi / 0.0254) * (0.7 + keta * 0.8));
______TextSize(txtSize);
______TextOrigin(0, 0);
______CreateText(s);
______LinkText(LNewObj, ParameterRec, Concat(keta));
____end;{NewText}
____
__begin{MakeSymbol}
____BeginSym(name);
______{ マスク }
______FillPat(1); PenSize(0);
______DrawPoly(0, 0, r2, n);
______PenSize(PenWidth);
______{ 文字 }
______FillPat(0); PenFore(Red);
______NewText(1, r);
______NewText(2, r);
______NewText(3, r);
______{ 円 }
______PenFore(Black);
______DrawPoly(0, 0, r, n);
____EndSym;
____Record(LNewObj, ParameterRec);
____for keta:= 1 to MaxTextLength do { レコードを空白に初期化 }
______Field(LNewObj, ParameterRec, Num2Str(0, keta), '');
__end;{MakeSymbol}
__
procedure DrawSymbol(x, y: real; symNm: string; s: string); { シンボルを描く }
__begin
____Symbol(symNm, x, y, 0);
____case Len(s) of
______1..MaxTextLength-1: Field(LNewObj, ParameterRec, Num2Str(0, Len(s)), s);
______otherwise
________Field(LNewObj, ParameterRec, Num2Str(0, MaxTextLength), s);
____end;
__end;{DrawSymbol}
__
function NextStr(s:string; st:integer):string;{ 前後の文字列を返す }
__var
____i, ii, j, bytes, cc1, cc2__:integer;
____chara__:string;
____ch, ch1__:char;
____cf__:boolean;
__
__function NextChar(s:string; st:integer{-1 or 1}; var cf:boolean):string;
__{ 前後の文字を返す }
____const
______Str1 = '01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza'; { 半角カナが必要なら末尾に追加する }
______Str1rv = '98765432109ZYXWVUTSRQPONMLKJIHGFEDCBAZzyxwvutsrqponmlkjihgfedcbaz'; { 半角カナが必要なら末尾に追加する }
______Str2 = '01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza';
______Str2rv = '98765432109ZYXWVUTSRQPONMLKJIHGFEDCBAZzyxwvutsrqponmlkjihgfedcbaz';
______Str2A = 'あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをんあアイウエオカキクケコサシスセソタチツテトナニヌネ ノハヒフヘホマミムメモヤユヨラリルレロワヲンア';
______Str2Arv = 'んをわろれるりらよゆやもめむみまほへふひはのねぬになとてつちたそせすしさこけくきかおえういあんンヲワロレルリラヨユヤモメムミマホヘフヒハノネヌ ニナトテツチタソセスシサコケクキカオエウイアン';
______Str2B = 'ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩΑαβγδεζηθικλμνξοπρστυφχψωα';
______Str2Brv = 'ΩΨΧΦΥΤΣΡΠΟΞΝΜΛΚΙΘΗΖΕΔΓΒΑΩωψχφυτσρποξνμλκιθηζεδγβαω';
____var
______i, i2, bt__:integer;
______str __:string;
____begin
______bt:= Len(s);
______case bt of
________1: if st < 0 then str:= Str1rv else str:= Str1;
________2: if st < 0 then str:= Str2rv else str:= Str2;
______end;
______i:= Pos(s, str);
______if (i = 0) & (bt = 2) then begin
________if st < 0 then str:= Str2Arv else str:= Str2A;
________i:= Pos(s, str);
______end;
______if (i = 0) & (bt = 2) then begin
________if st < 0 then str:= Str2Brv else str:= Str2B;
________i:= Pos(s, str);
______end;
______if i = 0 then
________cf:= false
______else begin
________s:= Copy(str, i+bt, bt);
________i2:= Pos(s, str);
________cf:= (i2 < i);
______end;
______NextChar:= s;
____end;{NextChar}
__
__begin{NextStr}
____for j:= 1 to Round(Abs(st)) do begin
______i:= len(s);
______cf:= true;
______while cf do begin
________if i = 1 then
__________bytes:= 1
________else begin
__________ch:= copy(s, i, 1);
__________cc2:= Ord(ch);
__________ii:= i - 1;
__________case Ord(ch) of
____________0..63, 127: bytes:= 1;
____________128, 224..252: bytes:= 2;
____________otherwise {64..126, 160..223} begin
______________if ii = 1 then
________________bytes:= 2
______________else begin
________________ch1:= copy(s, ii, 1);
________________cc1:= Ord(ch1);
________________case Ord(ch1) of
__________________129..159: bytes:= 2;
__________________224..252: bytes:= 1; { 第1バイトに224..252が現れることは想定していない }
__________________otherwise bytes:= 1;
________________end;
______________end;
____________end;
__________end;
________end;
________if bytes = 2 then
__________i:= ii;
________chara:= Copy(s, i, bytes);
________if st < 0 then
__________chara:= NextChar(chara, -1, cf)
________else
__________chara:= NextChar(chara, 1, cf);
________Delete(s, i, bytes);
________Insert(chara, s, i);
________i:= i - 1;
________if i < 1 then
__________cf:= false;
______end;
____end;
____NextStr:= s;
__end;{NextStr}

begin{main}
__PushAttrs;
__GetUnits(frac, dsAcc, format, upi, uMark, sqUMark);
__SetDef(txt, step, d, n);
__NameClass(ClassName);
__TextFont(GetFontID(TxFont));
__TextJust(Center);
__TextVerticalAlign(VertCenter);
__Marker(MarkerStyle, MarkerSize, MarkerAngle);
__for keta:= 1 to MaxTextLength do { レコード定義 }
____NewField(ParameterRec, Num2Str(0, keta), '', 4, 0);
__x0:= -1234567890; y0:= x0;
__result:= true;
__while result do begin
____Message('"', txt, '": 引出し線の開始位置からクリック-アンド-ドラッグしてください。');
____GetLine(x1, y1, x2, y2);
____result:= (r < Distance(x1, y1, x0, y0));
____if result then begin
______scl:= GetLScale(ActLayer);
______r:= d / 2 * scl * upi / 25.4; { 円の半径 }
______r2:= r * MaskSize; { マスクの半径 }
______symNm:= concat('Number(', n, '):', d * scl);
______if GetObject(symNm) = nil then
________MakeSymbol(symNm, r, r2, scl, n);
______DSelectAll;
______{ 引出線 }
______if distance(x1, y1, x2, y2) > r2 then begin
________PenSize(PenWidth);
________PenFore(Black);
________MoveTo(x1, y1);
________LineTo(x2, y2);
______end;
______{ 丸付き番号(シンボル) }
______DrawSymbol(x2, y2, symNm, txt);
______ReDraw;
______txt:= NextStr(txt, step);
______x0:= x2; y0:= y2;
______WriteDef(txt);
____end;{if}
__end;{while}
{__WriteDef(txt);__}
__PopAttrs;
__ClrMessage;
end;{MakeNumber4}
Run(MakeNumber4);


丸付き番号を描くスクリプト(3.875)    与太郎
Fri Dec 24 12:46:09 2010

2バイト文字に対応したNextChar関数です。

function NextStr(s:string; st:integer):string;{ 前後の文字列を返す }
__var
____i, ii, j, bytes, cc1, cc2__:integer;
____chara__:string;
____ch, ch1__:char;
____cf__:boolean;
__
__function NextChar(s:string; st:integer{-1 or 1}; var cf:boolean):string;
__{ 前後の文字を返す }
____const
______Str1 = '01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza'; { 半角カナが必要なら末尾に追加する }
______Str1rv = '98765432109ZYXWVUTSRQPONMLKJIHGFEDCBAZzyxwvutsrqponmlkjihgfedcbaz'; { 半角カナが必要なら末尾に追加する }
______Str2 = '01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza';
______Str2rv = '98765432109ZYXWVUTSRQPONMLKJIHGFEDCBAZzyxwvutsrqponmlkjihgfedcbaz';
______Str2A = 'あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをんあアイウエオカキクケコサシスセソタチツテトナニヌネ ノハヒフヘホマミムメモヤユヨラリルレロワヲンア';
______Str2Arv = 'んをわろれるりらよゆやもめむみまほへふひはのねぬになとてつちたそせすしさこけくきかおえういあんンヲワロレルリラヨユヤモメムミマホヘフヒハノネヌ ニナトテツチタソセスシサコケクキカオエウイアン';
______Str2B = 'ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩΑαβγδεζηθικλμνξοπρστυφχψωα';
______Str2Brv = 'ΩΨΧΦΥΤΣΡΠΟΞΝΜΛΚΙΘΗΖΕΔΓΒΑΩωψχφυτσρποξνμλκιθηζεδγβαω';
____var
______i, i2, bt__:integer;
______str __:string;
____begin
______bt:= Len(s);
______case bt of
________1: if st < 0 then str:= Str1rv else str:= Str1;
________2: if st < 0 then str:= Str2rv else str:= Str2;
______end;
______i:= Pos(s, str);
______if (i = 0) & (bt = 2) then begin
________if st < 0 then str:= Str2Arv else str:= Str2A;
________i:= Pos(s, str);
______end;
______if (i = 0) & (bt = 2) then begin
________if st < 0 then str:= Str2Brv else str:= Str2B;
________i:= Pos(s, str);
______end;
______if i = 0 then
________cf:= false
______else begin
________s:= Copy(str, i+bt, bt);
________i2:= Pos(s, str);
________cf:= (i2 < i);
______end;
______NextChar:= s;
____end;{NextChar}
__
__begin{NextStr}
____for j:= 1 to Round(Abs(st)) do begin
______i:= len(s);
______cf:= true;
______while cf do begin
________if i = 1 then
__________bytes:= 1
________else begin
__________ch:= copy(s, i, 1);
__________cc2:= Ord(ch);
__________ii:= i - 1;
__________case Ord(ch) of
____________0..63, 127: bytes:= 1;
____________128, 224..252: bytes:= 2;
____________otherwise {64..126, 160..223} begin
______________if ii = 1 then
________________bytes:= 2
______________else begin
________________ch1:= copy(s, ii, 1);
________________cc1:= Ord(ch1);
________________case Ord(ch1) of
__________________129..159: bytes:= 2;
__________________224..252: bytes:= 1; { 第1バイトに224..252が現れることは想定していない }
__________________otherwise bytes:= 1;
________________end;
______________end;
____________end;
__________end;
________end;
________if bytes = 2 then
__________i:= ii;
________chara:= Copy(s, i, bytes);
________if st < 0 then
__________chara:= NextChar(chara, -1, cf)
________else
__________chara:= NextChar(chara, 1, cf);
________Delete(s, i, bytes);
________Insert(chara, s, i);
________i:= i - 1;
________if i < 1 then
__________cf:= false;
______end;
____end;
____NextStr:= s;
__end;{NextStr}

255バイトに収まらないので2バイト文字の定数を3つに分けましたが、VW9以降ならchar型の動的
配列を使えば分ける必要はないかも知れません。


Re:シフトJISコードの1バイト文字と2バイト文字の判定    与太郎
Thu Dec 23 9:34:00 2010

そろそろ「丸付き番号を描くスクリプト」に戻れるかと思ったのですが、
>$E0(224)〜$FC(252)・・・2バイト文字の第1 or 第2バイト
で躓きました。
$E0(224)〜$FC(252)の文字コードが連続していると、2バイト文字の切れ目
が判らないからです。

つまり、文字列の末尾が1バイト文字か2バイト文字がを調べるときに、
文字コードが$40(64)〜$7E(126)か$A0(160)〜$DF(223)の場合は、1バイト文
字(半角英字、カナ、記号の一部)か2バイト文字か判らないのでひとつ
前のバイトを調べますが、
末尾から2バイト目の文字コードが$E0(224)〜$FC(252)の範囲である場合は、
その文字が2バイト文字の第1バイトか第2バイトか特定出来ません。
末尾から3バイト目を調べれば確定出来る場合もありますが、
末尾から3バイト目以降も$E0(224)〜$FC(252)の文字コードが連続すると
それ
以外の文字コードが現れるまでは文字の切れ目が判らないので、最悪の場合は
先頭までさかのぼらないと、末尾の文字が1バイト文字か2バイト文字か判定
出来ません。

だから、本当は文字列の先頭から1文字づつ調べて末尾の文字が1バイト文字
か2バイト文字かを判別しないといけません。
しかし、シフトJISコードでは第1バイトが$E0(224)〜$FC(252)の文字は第二
水準漢字なので、連番に使うことはないと思います。
それなら$E0(224)〜$FC(252)は2バイト文字の第2バイトにしか使わないとい
う条件付きで、文字列の末尾から調べる場合でも末尾とその前の2バイトだけ
で1バイト文字か2バイト文字かの判定は可能です。


Re:いろいろ御礼とお願いと。    与太郎
Fri Dec 17 19:05:21 2010

何を隠そうバックナンバー送り云々は口実で、
やっぱり文章だけでの説明は無理があると思ったのでした。

ついでに Sun Dec 5 の書き込みに、
× 40(64)〜$7E(126)と$A0(160)〜$DF(123)は
○ 40(64)〜$7E(126)と$A0(160)〜$DF(223)は
という間違いもありまして、どうもばがやろさまでした。


いろいろ御礼とお願いと。    管理人
Thu Dec 16 9:45:56 2010

与太郎さんの連載講座、バックナンバーに丸ごと送ってしまいました。
執筆のリズムを崩してしまい申し訳ありません。
学習に活用されていた皆さんにもご迷惑をお掛けします。
間もなく本年分をバックナンバーにまとめますが、
引き続き、よろしくお願いします。


シフトJISコードの1バイト文字と2バイト文字の判定    与太郎
Wed Dec 15 11:50:40 2010

前の書き込みはバックナンバー送りになったので、
ここらでシフトJISコードの1バイト文字と2バイト文字の判定方法を整理しときます。

ch:= Copy(s, index, 1); で、string型変数sから1文字(1バイト)をchar型変数chに取りせます。
Ord(ch) で、chの文字コードが判ります。
chが1バイト文字か2バイト文字かは、文字コードで判断します。
文字コードは$00(0)〜$FF(255)の値を持ち、シフトJISコードでは以下のように定義されています。

$00(0)〜$1F(31) ・・・・1バイト文字(制御文字)
$20(32)〜$3F(63)・・・・1バイト文字(半角数字、記号)
$40(64)〜$7E(126) ・・・2バイト文字の第2バイト or 1バイト文字(半角英字、記号)
$7F(127)・・・・・・・・1バイト文字(削除)
$80(128)・・・・・・・・2バイト文字の第2バイト
$81(129)〜$9F(159)・・・2バイト文字の第1バイト
$A0(160)〜$DF(223)・・・2バイト文字の第2バイト or 1バイト文字(半角カナ)
$E0(224)〜$FC(252)・・・2バイト文字の第1 or 第2バイト
$FD(253)〜$FF(255)・・・未定義

先頭から調べる場合、chは1バイト文字か2バイト文字の第1バイトのどちらかです。
この2つは文字コードが重ならないので、判別するのは簡単です。
$00(0)〜$7F(127)と$A0(160)〜$DF(223)ならchは1バイト文字、
$81(129)〜$9F(159)と$E0(224)〜$FC(252)なら2バイト文字の第1バイトと判断できます。

末尾から調べる場合、chは1バイト文字か2バイト文字の第2バイトのどちらかです。
この2つは文字コードが重なっている部分があるので、
$00(0)〜$3F(63)と$7F(127)ならchは1バイト文字、
$80(128)と$E0(224)〜$FC(252)なら2バイト文字と判りますが、
$40(64)〜$7E(126)と$A0(160)〜$DF(223)だと1バイト文字と2バイト文字のどちらか判りません。
その場合、chのひとつ前の文字(バイト)を調べます。
ひとつ前の文字は、1バイト文字か2バイト文字の第1バイトのどちらかのはずです。
ひとつ前の文字が1バイト文字ならchは1バイト文字、
2バイト文字の第1バイトならchは2バイト文字の第2バイトです。

ということで、文字列を末尾から調べる場合でも、1バイト文字か2バイト文字かの判定は、
末尾とそのひとつ前の文字の2文字で可能なようです。



業務連絡    管理人
Thu Dec 9 20:24:05 2010

お手数ですが、荒らし対策のため、
直リンクされている方はトップ頁から入り直して下さい。


 シフトJISの2バイト文字    与太郎
Sun Dec 5 23:19:17 2010

シフトJISコードには1バイト文字と2バイト文字がありますが、前々回の文字コード表は1バイト
文字の部分でした。一般には半角文字と呼ばれる文字です。
そして今回はシフトJISの全角文字の話です。

全角半角というのは本来は文字の幅のことですが、歴史的経緯により半角文字は1バイト、全角文
字は2バイトということになっています。
文字幅はフォントで面倒見るのがスジでしょうけど、マルチフォント環境が一般化する前に全角半
角という文化が定着してしまったので仕方がありません。
実際には半角カナは1バイト文字と2バイト文字の両方があるし、フォントによっては一部の2バ
イト文字の幅は全角ではないし、スクリプトでは文字の幅より文字のバイト数のほうが重要なので、
以降は半角全角ではなく1バイト文字、2バイト文字と呼びたいと思います。
ユニコードでは1文字が4バイト以上の場合もありますが、VectorScriptでは扱わないのでここで
は触れません。

半角文字と全角文字を混ぜて使うには、文字コードを途中で切り替える必要がありますが、その方
法はメーカーごとに異なり、ファイルの互換性はありませんでした。
(ディスクのフォーマットも統一されてなかったので読むこと自体出来なかったのですが。)
それでは困るというのでMicrosoftが中心になって作ったのがシフトJISコードです。
最初の頃はMS漢字コードとも呼ばれていました。
MS-DOSはもちろん、旧Mac OSの日本語でもシフトJISが採用されました。
当然VectorScriptでも文字はシフトJISコードとして扱います。

シフトJISでは、1バイト文字コードの未使用の部分を2バイト文字の1バイト目として使用します。
1バイト文字コードの$00(0)〜$1F(31)と$7F(127)は制御文字、$20(32)〜$7E(126)は半角英数字、
$A0(160)〜$DF(223)が半角カナなので、残りの番号は$80(128)〜$9F(159)と$E0(224)〜$FF(256)です。
実際には2バイト文字として使われるのは$81(129)〜$9F(159)と$E0(224)〜$FC(252)で、使える番号は
31 + 29 = 60個です。
文字コードがその60個の範囲内であれば、その文字は2バイト文字の第1バイトになり、次のバイ
トと組合せて2バイトを1文字として扱います。
第2バイトの値は$40(64)〜$7E(126)か$80(128)〜$FC(252)で、使える番号は63 + 125 = 188個です。
188個というのは区点の数(94)のちょうど2倍ですが、それは偶然ではありません。
第1バイトで使える番号が60個しかなく、1個の番号に1区を割り当てると94区全部が入らないので、
第1バイトの1個の番号に2区分を割り当てる必要があったからです。
つまり、シフトJISの第1バイトには、1区と2区(JIS漢字コードの$21と$22)が$81(129)、3区と
4区(JIS漢字コードの$23と$24)は$82(130)というふうに割り当てられます。
JIS漢字コード表を255列(第1バイト)×255列(第2バイト)で表すと、実際に使われている部分は下の
ように94×94の正方形になります。

□□□□|□□□□
□■■■|□□□□
□■■■|□□□□
□■■■|□□□□
□□□□|□□□□
□□□□|□□□□
□□□□|□□□□
□□□□|□□□□

シフトJISコードでは、それが4箇所に移動(シフト)しています。

□□□□|□□□□
□□□□|□□□□
□□□□|□□□□
□□□□|□□□□
□□■■|■■■■
□□□□|□□□□
□□□□|□□□□
□□■■|■■■■

これが「シフト」JISの由来です。

想像付くと思いますが、JIS漢字コードとシフトJISコードのコード変換は少々面倒です。
何故こんな複雑なことをするかというと、
(1) シフトJISコードの環境では、欧米の1バイトコード(7ビット)がそのまま通る。
(2) 半角文字と全角文字の切り替えに、制御文字やエスケープ・シーケンスを使わずに済む。
(3) 等幅フォントでは文字列の表示幅とバイト数が比例する。
の2つの利点があったからです。

1バイト文字と2バイト文字が混在したシフトJISコードの文字列があるとき、文字列の先頭から調
べた場合は1バイト文字と2バイト文字の区別は簡単で、$81(129)〜$9F(159)と$E0(224)〜$FC(252)
なら2バイト文字、それ以外なら1バイト文字と判ります。
しかし、文字列の最期から調べる場合は簡単ではありません。
$00(0)〜$3F(63)か$7F(127)なら1バイト文字、$80(128)〜$9F(159)と$E0(224)〜$FC(252)なら2バイ
ト文字と判りますが、40(64)〜$7E(126)と$A0(160)〜$DF(123)は1バイト文字と2バイト文字の第2バ
イトのどちらでもありうるので、左隣の文字も調べないと1バイト文字か2バイト文字かは区別出来ません。
左隣の文字が1バイト文字だったら1バイト文字、2バイト文字の第1バイトなら2バイト文字とい
うことになります。
左隣も1バイト文字か2バイト文字か判断出来ないときは、2バイト文字の第2バイトが連続して並ぶ
はずはないので、1バイト文字と考えて良いでしょう。

しかし、シフトJISの1バイト文字と2バイト文字の判定は、後ろからだと最悪最初の文字まで調べない
と出来ない、と書いてあるのを見たこともあるので、それでは判定し切れないのかも知れませんが。


Re:JIS漢字コードについて    与太郎
Thu Nov 25 21:22:55 2010

初代MacのROMは32KBじゃなくて64KBでしたね、確か。
失礼いたしました。


JIS漢字コードについて    与太郎
Thu Nov 25 20:46:57 2010

8ビットCPUでメモリが64KBの頃は、アプリケーション・ソフトウェアを買って使うことは少なく、
自分で組んだBASICのプログラムを使うのが普通でした。
その頃は漢字を使えるパソコンのほうが珍しかったし、使えなくても不便とは思いませんでした。
当時は320×200ドットの画面に8×8ドットの文字を40×25行表示するか、640×200ドットの画面
に80×25行表示するのが普通でした。(行間を空けた20行モードというのもありました。)
8×8ドットでは漢字など表現できるはずもありません。

しかしパソコンの能力が上がって計算以外の用途(ワープロなど)に使われるようになると、漢字
を扱えないと話になりません。
そこで漢字ROMを搭載したり、オプションで搭載可能なパソコンが現れました。
16ビットパソコンの代表ともいえるPC-9801では、640×400ドットの画面に半角文字なら80×25行、
全角文字なら40×25行表示出来ました。
半角文字は8×16ドット、全角文字は16×16ドットだったわけです。
16×16ドットのビットマップ・データは32バイトなので、第一水準漢字2,965文字と非漢字524文字
だけでも110KBになります。このデータが漢字ROMに書き込まれていました。
初代MacのROMが32KBだったことを考えれば、これは結構なサイズです。値段も高かったでしょうか
ら、初期にはオプション扱いだったのも当然です。
メモリ空間に対してサイズが大き過ぎるのと、CPUではなくグラフィックコントローラからアクセス
するため、漢字ROMはメモリ空間には存在しません。
当時はCPUが遅かったので、テキストVRAMに文字コードを書き込むまでがCPUの担当で、そこから
先(テキストVRAMの文字コードを読んで、漢字ROMからビットマップ・データを呼び出し、画面の
適切な位置に文字が表示されるように表示用VRAMに書き込む)はグラフィックコントローラの仕事
でした。

・・・・ ちなみに、ほぼ同時代にMacintoshは(英語限定ですが)それらを全部CPUでやっていました。
・・・・ 16ビットのi8086と32ビットに少々不足なMC6800の違いはあるにせよほぼ同クロック速度で、
・・・・ 同じ128KBのメモリでも専用VRAMがない分21KBは画面表示用に取られてしまうのですから、
・・・・ メモリ使用量と処理速度が極限まで最適化されてなければ不可能だったでしょう。
・・・・ テキストVRAM方式では、同じ大きさの文字を決まった升目の中にしか描けませんが、
・・・・ Macではグラフィック画面に文字を描くので、文字データさえあればビットマップフォント
・・・・ でもアウトラインフォントでも自由な位置に好きなサイズの文字を描けました。
・・・・ 
・・・・ PC-9801のグラフィックVRAMは画面1枚当たり32KB(640×400/8/1024 = 31.25)で、当初
・・・・ は3枚分のVRAMを持っていました。これを白黒モードなら3画面として表示を切り替えなが
・・・・ ら使えて、カラーモードのときは3ビットなので8色を表示出来ました。
・・・・ 三枚分のVRAMはメモリ空間に連続して割り当てられ、CPUからも直接読み書き出来ました。
・・・・ このVRAM構成では1ピクセルのデータがメモリ上で分散しているので、色数を簡単には増や
・・・・ せません。後にメモリ空間の隙間にもう32KB押し込んで16色表示になりましたが、それが
・・・・ 限界でした。
・・・・ 一方、PCやMacでは1ピクセルは連続したビット列になっていました。
・・・・ 初代Macは白黒なので関係ありませんが、1ピクセルを8ビット、16ビット、32ビットと拡
・・・・ 張して、難なくフルカラーを実現しています。
・・・・ 1、2、4、8、16、32と2の倍数になっているのは、ピクセルデータの区切りがバイトの
・・・・ 境界と重なるようにするためです。そのため16ビットモードでは各RGBに5ビットを割り当
・・・・ てて、残り1ビットは余らせています。24ビットモードで32ビット(4バイト)使うのは、
・・・・ 32ビットCPUで一度に読み書きできるのが1、2、4バイトだからです。
・・・・ (文字コードと関係ない話になってきたので、このへんで止めときます。)

文字のビットマップ・データは、グラフィックコントローラが一度に1文字分を呼び出します。
そのとき文字の指定はJIS漢字コードで行います。

*********************************************************************************

JIS漢字コードは、1バイト=7ビットからなる2バイトの文字コードです。
制御文字やエスケープシーケンスで半角文字と全角文字を切り替えていました。
1バイト=7ビットという仕様は、国際規格のASCIIコードに合わせるためです。
7ビット(0〜127)あれば制御文字、数字と英字、各種記号を表現出来たし、昔は文字コードの
ビット数を減らすことがとても重要と考えられていました。実際、小文字を省略した6ビット(0
〜63)の文字コードも使われていました。
JISの半角英数字の文字コードも7ビットで、半角カナは別の7ビット文字コードとして定義され、
これも制御文字やエスケープシーケンスで切り替えて使いました。
1バイト=7ビットということは、各バイトは$00〜$7F(127)の値を表せますが、$00〜$1F(31)の
制御文字と$20(32)のスペース、そして$7F(127)の'削除'の部分は文字コードには使われません。
これは、それらの文字を文字コードの種類に関係なく判別出来るようにするためです。
そういうことなので、使えるのは$21(33)〜$7E(126)の94個の番号です。

JIS漢字コードの第一(上位)バイトの$21〜$7Eを1区〜94区、第二(下位)バイトの$21〜$7Eを
1点〜94点としたのが区点コードです。94区×94点で8836文字まで使えるということです。
たとえば全角の'あ'は、区点コードでは4区2点になります。
区点コードをJIS漢字コードに直すには、区と点にそれぞれ$20(32)を足してくっ付けます。
4区2点なら4 + $20 = $24、2 + $20 = $22で、合わせると$2422になります。
$2422は10進数では、2×4096 + 4×256 + 2×16 + 2 = 9250ですが、この数字は一般に利用価値が
ありません。
2バイト文字コードは第1バイトと第2バイトは別々のままのほうが扱いやすいです。
つまり、第1バイトは2×16 + 4 = 36、第2バイトは2×16 + 2 = 34になります。

以上でJIS漢字コードについての説明は終りますが、実はVectorScriptではJIS漢字コードを直接扱
うことはありません。
VectorScriptでは、全角文字にはシフトJISコードが使われています。


2進数、16進数、文字コードについて    与太郎
Tue Nov 16 12:51:23 2010

2進数や16進数の知識がなくてもVectorScriptを書くのに不自由はありません。
しかし、文字コード表は16進数表記が当たり前なので、知っておいて損はありません。

2進数は誰でも知っているとおり、数字を0と1で表します。
2進数の意味は、1桁に2つの数字(0、1)があるということです。
メモリはONとOFFしか表せない素子が沢山集まったものです。
メモリの素子1つで表せる数が1ビットで、これは2進数の1桁でもあります。
8ビットなら2進数の8桁になります。

1つでは0と1の値しかありませんが、沢山集まれば大きな数を表せます。

とは言え、1000でさえ2進数では 1111101000 と10桁にもなり、読みにくいです。
2進数の 1111101000 を10進数にするには 512 + 256 + 128 + 64 + 32 + 8 = 1000 と計算します。
略さないで書くと、
1×512 + 1×256 + 1×128 + 1×64 + 1×32 + 0×16 + 1×8 + 0×4 + 0×2 + 0×1 です。

10進数を2進数に直すのは少し面倒です。
たとえば1000なら、
1000/2 = 500、余り[0]
500/2 = 250、余り[0]
250/2 = 125、余り[0]
125/2 = 62、余り[1]
62/2 = 31、余り[0]
31/2 = 15、余り[1]
15/2 = 7、余り[1]
7/2 = 3、余り[1]
3/2 = 1、余り[1]
1/2 = 0、余り[1]
の余りを下から繋げて 1111101000 とします。

2進数でも3桁ごとに区切れば、1,111,101,000 のように少しは読みやすくなります。
もう一歩進めて3ビットをまとめて1桁にすれば、下のように1桁で0〜7を表せます。

元  2進
0   000
1   001
2   010
3   011
4   100
5   101
6   110
7   111

0〜7の8個の数字で1桁なので、8進数ということになります。
1,111,101,000 を8進数に直すと 1→[1], 111→[7], 101→[5], 000→[0] なので、1750になります。
8進数の1750を2進数に直すのも、1→[001], 7→[111], 5→[101], 0→[000] と、とても簡単です。
10進数に直すには、1×512 + 7×64 + 5×8 + 0×1 と計算します。
10進数の1000を8進数に直すのは、
1000/8 = 125、余り[0]
125/8 = 15、余り[5]
13/8 = 1、余り[7]
1/8 = 0、余り[1]
なので、これも下から繋げると 1750 になります。

このように、10進数と2進数の変換にくらべて8進数と2進数の変換のほうが楽なので、かっては8進
数が良く使われました。

現在では特記しない限りは1バイト=8ビットです。
8ビットを4ビット単位で区切れば2桁の数字で表せます。
4ビットは0〜15までの16個の数字を表せるので、16進数を使うのが理屈に合っています。
16進数の表記は、9以降の10〜15を下のようにA〜Fに置換えます。

10進 2進 16進
0  0000  0
1  0001  1
2  0010  2
3  0011  3
4  0100  4
5  0101  5
6  0110  6
7  0111  7
8  1000  8
9  1001  9
10  1010  A
11  1011  B
12  1100  C
13  1101  D
14  1110  E
15  1111  F

1000を16進数に直すと、
1000/16 = 62、余り[8] →8
62/16 = 3、余り[14]→E
3/16 = 0、余り[3] →3
なので、3E8 になります。
これを2進数に戻すには 3→[0011], E→[1110], 8→[1000] で、つなげれば 1111101000 になります。
16進数の3E8を10進数に直す式は、3×256 + 14×16 + 8×1 です。

以上のように、16進数も2進数との変換が簡単です。
1バイト=8ビットだと1バイトを2桁で表せて都合が良いこともあり、16進数は良く使われます。

8ビットで表せる数は、10進数では0〜255、16進数では0〜FFです。
10進数と区別するため、C言語では16進数の数字の先頭に'0x'を付けます。
プログラム言語によっては先頭に'$'を付けたり、末尾に'h'を付けたりします。
VectorScriptでは16進数を表記することは出来ません。

1バイト文字の文字コード表には、文字コード0〜255までの文字が並んでいます。
文字コード表は縦一列の場合もありますが、たいていは16行×16列の表です。
縦方向(行)が16進数の上位桁、横方向(列)が下位桁になっています。

\ 0123456789ABCDEF
0 ・・・・・・・・・・・・・・・・
1 ・・・・・・・・・・・・・・・・
2  !”#$%&’()*+,−./
3 0123456789:;<=>?
4 @ABCDEFGHIJKLMNO
5 PQRSTUVWXYZ[¥]^_
6 ‘abcdefghijklmno
7 pqrstuvwxyz{|}〜・
8 ・・・・・・・・・・・・・・・・
9 ・・・・・・・・・・・・・・・・
A ・。「」、・ヲァィゥェォャュョッ
B ーアイウエオカキクケコサシスセソ
C タチツテトナニヌネノハヒフヘホマ
D ミムメモヤユヨラリルレロワン゛゜
E ・・・・・・・・・・・・・・・・
F ・・・・・・・・・・・・・・・・

'A'は(4)行の(1)列にあるので文字コードは16進数の(41)、10進数に直すと 4×16 + 1 = 65 です。
半角の'オ'は(B)行の(5)列なので16進数の(B5)、10進数では 11×16 + 5 = 181 です。
10進数の205は、 205/16 = 12、余り=13 なので16進数では(CD)です。
文字コードが(CD)の文字は、(C)行の(D)列にある半角'へ'になります。

VectorScriptのOrd()は、1バイト文字の文字コードを返します。Ordはorder(順番)の略です。
Ord('A')なら65が返ります。文字コード表の65番目の文字ということです。
Chr()は文字コードに対応する文字を返します。
Chr(205)は文字コード表の205番目の文字、半角'へ'を返します。
関数で値を取り出すので、数字の205と半角文字の'へ'は一見別物に見えますが、どちらも11001101
という8ビットデータの異なる解釈に過ぎません。
とは言え、数字は数字、文字は文字で別物と考えた方が判りやすいし、間違いも減るでしょう。

なんだか話が本題からずれて行きそうなので、一応このへんで止めておきます。


丸付き番号を描くスクリプト(3.75)    与太郎
Tue Nov 9 14:58:15 2010

'-', ':', '=', スペースなどは別の文字に変わって欲しくないけど、
選択肢が多くなるとCase文が長くなって、書くのが面倒になってきます。
でも安心して下さい。Pos()とCopy()を使う楽な方法があります。
下は、改良したNextStr関数です。

function NextStr(s:string; st:integer):string;{ 前後の文字列を返す(半角文字のみ) }
__var
____i, j__:integer;
____ch__:char;
____cf__:boolean;
__
__function NextChar(ch:char; st:integer;{-1 or 1} var cf:boolean):char;
__{ 前後の文字を返す }
____const
______Str1 = '01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZAabcdefghijklmnopqrstuvwxyza'; { 半角カナが必要なら末尾に追加する }
______Str1rv = '98765432109ZYXWVUTSRQPONMLKJIHGFEDCBAZzyxwvutsrqponmlkjihgfedcbaz'; { 半角カナが必要なら末尾に追加する }
____var
______i, i2__:integer;
______str __:string;
____begin
______if st < 0 then
________str:= Str1rv
______else
________str:= Str1;
______i:= Pos(ch, str);
______if i = 0 then begin
________cf:= false;
______end
______else begin
________i:= i + 1;
________ch:= Copy(str, i, 1);
________i2:= Pos(ch, str);
________cf:= (i <> i2); { 繰り上げの判定 }
______end;
______NextChar:= ch;
____end;{NextChar}
__
__begin{NextStr}
____for j:= 1 to Abs(st) do begin
______i:= len(s);
______cf:= true;
______while cf do begin
________ch:= copy(s, i, 1);
________if st < 0 then
__________ch:= NextChar(ch, -1, cf)
________else
__________ch:= NextChar(ch, 1, cf);
________Delete(s, i, 1);
________Insert(ch, s, i);
________i:= i - 1;
________if i < 1 then
__________cf:= false;
______end;
____end;
____NextStr:= s;
__end;{NextStr}

NextChar関数は、文字がstrの中にあればその次の文字を返し、なければ元の文字を返します。
定数Str1は正順、Str1rvは逆順の文字列です。
Str1の中には'0'が2つありますが、Pos()で返るのは最も左側の位置(左端から検索して最初に
一致した位置)なので、'0'の位置は11ではなく1で、次の文字は'A'ではなく'1'になります。
ただ単に次の文字を知りたいだけなら「12345678901」でも「23456789012」でも構いませんが、
繰り上げの有無を知るには「01234567890」である必要があります。繰り上げの判定は、
______else begin
________i:= i + 1;
________ch:= Copy(str, i, 1);
________i2:= Pos(ch, str);
________cf:= (i <> i2); { 繰り上げの判定 }
______end;
でやっています。
データ(この場合は定数)を工夫することで、スクリプトを単純に出来ました。
ただし、Pos()は文字列を左から順番に調べてるはずなので、文字列の長さに比例して処理時間も
かかるでしょうから、ループで何万回も実行するなら別の方法を考えるでしょう。
今回は1クリック当たり1〜数回の実行なので、気にしてもしょうがないですが。

定数str1を変えれば「イロハニ...」順にも出来ます。(半角カナには'ヰ'と'ヱ'がないので、そ
の部分は飛んでしまいますが。)
'I', 'O'は数字と間違いやすいので使いたくないときは、「ABCDEFGHJKLMNPQRSTUVWXYZA」とすれ
ばいいです。
「012345670」で8進数、「0123456789ABCDEF0」で16進数も可能です。


Re:丸付き番号を描くスクリプト(3.5)    与太郎
Mon Nov 8 17:45:50 2010

>スクリプト内の半角カナは全て全角カナにしています。
>実行するときには半角カナに直して下さい。

これを書いた後スクリプトのほうを半角カナを使わないように直したので、
この2行は不要です。


丸付き番号を描くスクリプト(3.5)    与太郎
Sun Nov 7 9:12:54 2010

場合によっては数字だけじゃなくて「A, B, C, D...」とか「ア, イ, ウ, エ...」とか、
「A1, A2, A3, A4...」と描きたいこともあるので、そういうふうに改造してみます。
グローバル変数c:integer を txt:string にして、
c:= c + step; の行を txt:= NextStr(txt, step); に直して、関数定義部を追加します。
その他、c⇒txt の変更に関係する箇所を修正します。
全角文字に対応しなくて良いなら、下のようなスクリプトになります。
スクリプト内の半角カナは全て全角カナにしています。
実行するときには半角カナに直して下さい。

procedure MakeNumber35;
{ 丸付き番号を描く(シンボル版-半角文字) }
{$ DEBUG}
const
__WrkSheet = 'Number-Def';
__ParameterRec = 'Number-Rec';
__ClassName = '番号';
__MaxTextLength = 3; { 最大文字数 }
__TxFont = 'MS ゴシック';
__Center = 2;
__VertCenter = 3;
__DefaultText = 'A';
__DefaultStep = 1;
__DefaultDia = 5{m/m};
__DefaultPoly = 0; { 多角形の頂点の数= -9..-3, 0, 3..9 }
__Red = 15;
__Black = 255;
__PenWidth = 6; { (mil) }
__MaskSize = 1.1; { マスクの倍率 }
__MarkerStyle = 13; { 始点に黒丸 }
__MarkerSize = 0.04; { (inch) }
__MarkerAngle = 0; { (degree) }
__WSTextSize = 12;
__
var
__result__:boolean;
__symNm__:string;
__x0, y0, x1, y1, x2, y2, d, r, r2, scl__:real;
__txt__:string;
__keta, step, n__:integer;
__frac, dsAcc__:longint;
__format__:integer;
__upi__:real;
__uMark, sqUMark__:string;
__
procedure WriteDef(s: string); { 初期値をWSに書き込む }
__var
____h__:handle;
____f__:integer;
__begin
____TextSize(WSTextSize);
____h:= GetObject(WrkSheet);
____SelectSS(h);
____SprdFormat(1, 0, '', '');
____LoadCell(1, 2, s);
____LoadCell(1, 1, 'Index =');
__end;{WriteDef}
__
procedure SetDef(var s:string; var st:integer; var d:real; var n:integer);
{ 初期値、増減分、直径、多角形の頂点の数を設定する }
__const
____F = 3; { 直径の少数点以下桁数 }
__var
____h__:handle;
__begin
____h:= GetObject(WrkSheet);
____if h = nil then begin
______s:= StrDialog('Index =', DefaultText);
______st:= RealDialog('Step =', Num2Str(0, DefaultStep));
______d:= RealDialog('Dia(m/m) =', Num2Str(F, DefaultDia));
______n:= RealDialog('N(0:円) =', Num2Str(0, DefaultPoly));
______NewSprdSheet(WrkSheet, 0, 0, 4, 2, false, true);
______TextSize(WSTextSize);
______SprdFormat(1, 0, '', '');
______LoadCell(1, 1, 'Index ='); LoadCell(1, 2, s);
______LoadCell(2, 1, 'Step ='); LoadCell(2, 2, Num2Str(0, st));
______LoadCell(4, 1, 'N(0:円) ='); LoadCell(4, 2, Num2Str(0, n));
______SprdFormat(1, f, '', '');
______LoadCell(3, 1, 'Dia(m/m) ='); LoadCell(3, 2, Num2Str(F, d));
______h:= GetObject(WrkSheet);
____end
____else begin
______s:= GetCellStr(h, 1, 2);
______st:= GetCellNum(h, 2, 2);
______d:= GetCellNum(h, 3, 2);
______n:= GetCellNum(h, 4, 2);
____end;
____if (abs(n) < 3) | (9 < abs(n)) then begin
______n:= 0;
______SelectSS(h);
______SprdFormat(1, 0, '', '');
______LoadCell(4, 2, Num2Str(0, n));
____end;
__end;{SetDef}
__
procedure DrawPoly(x, y:real; r:real; nP:integer);
__var
____i, n__:integer;
____q, a__:real;
__begin
____if nP=0 then
______Oval(x - r, y - r, x + r, y + r)
____else begin
______n:= Abs(nP);
______q:= r / Cos(Deg2Rad(180/n));
______q:= q * Sqrt(pi / n / Tan(Deg2Rad(180/n)));
______a:= 90;
______case nP of
________-9, -7, -5, -3, 4, 6, 8:
__________a:= a + 180/n;
______end;
______ClosePoly;
______BeginPoly;
______for i:= 1 to n do begin
________AddPoint(x + q*cos(Deg2Rad(a)), y + q*sin(Deg2Rad(a)));
________a:= a + 360/n;
______end;
______EndPoly;
____end;
__end;{DrawPoly}

procedure MakeSymbol(name:string; r, r2, scl:real; n:integer); { シンボルを定義する }
__var
____keta__:integer;
____
__procedure NewText(keta:integer; r:real); { Record Fieldに連結した文字を作る }
____var
______i__:integer;
______txtSize__:real;
______s__:string;
____begin
______s:= '';
______for i:= 1 to keta do
________s:= Concat(s, '0');
______txtSize:= 12 * r * 650 / ((scl * upi / 0.0254) * (0.7 + keta * 0.8));
______TextSize(txtSize);
______TextOrigin(0, 0);
______CreateText(s);
______LinkText(LNewObj, ParameterRec, Concat(keta));
____end;{NewText}
____
__begin{MakeSymbol}
____BeginSym(name);
______{ マスク }
______FillPat(1); PenSize(0);
______DrawPoly(0, 0, r2, n);
______PenSize(PenWidth);
______{ 文字 }
______FillPat(0); PenFore(Red);
______NewText(1, r);
______NewText(2, r);
______NewText(3, r);
______{ 円 }
______PenFore(Black);
______DrawPoly(0, 0, r, n);
____EndSym;
____Record(LNewObj, ParameterRec);
____for keta:= 1 to MaxTextLength do { レコードを空白に初期化 }
______Field(LNewObj, ParameterRec, Num2Str(0, keta), '');
__end;{MakeSymbol}
__
procedure DrawSymbol(x, y: real; symNm: string; s: string); { シンボルを描く }
__begin
____Symbol(symNm, x, y, 0);
____case Len(s) of
______1..MaxTextLength-1: Field(LNewObj, ParameterRec, Num2Str(0, Len(s)), s);
______otherwise
________Field(LNewObj, ParameterRec, Num2Str(0, MaxTextLength), s);
____end;
__end;{DrawSymbol}
__
function NextStr(s: string; st:integer): string;{ 前後の文字列を返す }
__const
____AA = 167; { 半角:ア }
____WA = 220; { 半角:ワ }
____WO = 166; { 半角:ヲ }
____NN = 221; { 半角:ン }
__var
____i, j__:integer;
____ch__:char;
____cf__:boolean;
__
__function NextChar(ch: char; var cf: boolean): char;{ 次の文字を返す }
____begin
______cf:= true;
______case Ord(ch) of
________Ord('9'): ch:= '0';
________Ord('z'): ch:= 'a';
________Ord('Z'): ch:= 'A';
________WA: ch:= Chr(WO);
________WO: ch:= Chr(NN);
________NN: ch:= Chr(AA);
________otherwise
__________ch:= chr(ord(ch) + 1);
______end;
______case Ord(ch) of
________Ord('0'), Ord('a'), Ord('A'), AA: cf:= true;
________otherwise cf:= false;
______end;
______NextChar:= ch;
____end;{NextChar}
____
__function PrevChar(ch: char; var cf: boolean): char;{ 前の文字を返す }
____begin
______case Ord(ch) of
________Ord('0'): ch:= '9';
________Ord('a'): ch:= 'z';
________Ord('A'): ch:= 'Z';
________WO: ch:= Chr(WA);
________NN: ch:= Chr(WO);
________AA: ch:= Chr(NN);
________otherwise
__________ch:= chr(ord(ch) - 1);
______end;
______case Ord(ch) of
________Ord('9'), Ord('z'), Ord('Z'), NN: cf:= true;
________otherwise cf:= false;
______end;
______PrevChar:= ch;
____end;{PrevChar}
____
__begin{NextStr}
____for j:= 1 to Round(Abs(st)) do begin
______i:= len(s);
______cf:= true;
______while cf do begin
________ch:= copy(s, i, 1);
________if st < 0 then
__________ch:= PrevChar(ch, cf)
________else
__________ch:= NextChar(ch, cf);
________Delete(s, i, 1);
________Insert(ch, s, i);
________i:= i - 1;
________if i < 1 then
__________cf:= false
______end;
____end;
____NextStr:= s;
__end;{NextStr}

begin{main}
__PushAttrs;
__GetUnits(frac, dsAcc, format, upi, uMark, sqUMark);
__SetDef(txt, step, d, n);
__NameClass(ClassName);
__TextFont(GetFontID(TxFont));
__TextJust(Center);
__TextVerticalAlign(VertCenter);
__Marker(MarkerStyle, MarkerSize, MarkerAngle);
__for keta:= 1 to MaxTextLength do { レコード定義 }
____NewField(ParameterRec, Num2Str(0, keta), '', 4, 0);
__x0:= -1234567890; y0:= x0;
__result:= true;
__while result do begin
____Message('"', txt, '": 引出し線の開始位置からクリック-アンド-ドラッグしてください。');
____GetLine(x1, y1, x2, y2);
____result:= (r < Distance(x1, y1, x0, y0));
____if result then begin
______scl:= GetLScale(ActLayer);
______r:= d / 2 * scl * upi / 25.4; { 円の半径 }
______r2:= r * MaskSize; { マスクの半径 }
______symNm:= concat('Number(', n, '):', d * scl);
______if GetObject(symNm) = nil then
________MakeSymbol(symNm, r, r2, scl, n);
______DSelectAll;
______{ 引出線 }
______if distance(x1, y1, x2, y2) > r2 then begin
________PenSize(PenWidth);
________PenFore(Black);
________MoveTo(x1, y1);
________LineTo(x2, y2);
______end;
______{ 丸付き番号(シンボル) }
______DrawSymbol(x2, y2, symNm, txt);
______ReDraw;
______txt:= NextStr(txt, step);
______x0:= x2; y0:= y2;
____end;{if}
__end;{while}
__WriteDef(txt);
__PopAttrs;
__ClrMessage;
end;{MakeNumber35}
Run(MakeNumber35);

ある文字の前後の文字は、基本的には文字コードに1を足したり引いたりすれば得られますが、
'9'⇔'0'、'Z'⇔'A'、'z'⇔'a'、'ン'⇔'ア'は連続してないので例外処理が必要です。
このとき繰り上げをしないといけないので、cf(carry flag)をtrueにします。
半角の'ワ', 'オ', 'ン'も連続していないので、'ワ'⇔'オ'、'オ'⇔'ン'の例外処理も必要です。

このスクリプトでは、繰上げや繰下げが発生しても文字数の増減はしないので、
'9'+1⇒'0'、'A9'+1⇒'B0、'10'-1⇒'09'、'A10'-1⇒'A09、になります。
'9'+1⇒'10'、'A9'+1⇒'A10'のように文字数を増やしたいときは、一旦停止して初期値を'10'や'A10'に
してからスクリプトを実行します。
また、数字の前の'-'はマイナス記号とは認識しないので、「-1, -2, -3...」とするときもStepの値は
+1に設定します。

以下の部分、
______case Ord(ch) of
________Ord('9'): ch:= '0';
________Ord('z'): ch:= 'a';
________Ord('Z'): ch:= 'A';
________WA: ch:= Chr(WO);
________WO: ch:= Chr(NN);
________NN: ch:= Chr(AA);
________otherwise
__________ch:= chr(ord(ch) + 1);
______end;
______case Ord(ch) of
________Ord('0'), Ord('a'), Ord('A'), AA: cf:= true;
________otherwise cf:= false;
______end;
は、半角カナを書かないようにしたので混沌としていますが、本当は、
______case ch of
________'9': ch:= '0';
________'z': ch:= 'a';
________'Z': ch:= 'A';
________'ワ': ch:= 'ヲ';
________'ヲ': ch:= 'ン';
________'ン': ch:= 'ア';
________otherwise
__________ch:= chr(ord(ch) + 1);
______end;
______case ch of
________'0', 'a', 'A', 'ア': cf:= true;
________otherwise cf:= false;
______end;
のように見やすく書けます。


丸付き番号を描くスクリプト(3)    与太郎
Thu Nov 4 0:42:11 2010

MacPlotは面の陰線処理までやってくれる優秀なプロッタドライバで、オプションでフォントや面
の模様を忠実に再現出来ました。
ただし、その機能はドットを1個ずつ打つという、ほとんど耐久テストのようなものだったので、
ほとんどはプロッタのフォントで描かせていました。

元のフォントとは違うのですから、文字の位置や幅が違うこともあるわけで、モニタ上やプリンタ
印刷で文字が収まっていても、実際にペンプロッタで描いて確認しないと判りません。
紙に描かせたものを見ながら文字ずれを修正するのですが、
水平や90°回転した文字なら一度に選択して直せても、角度の異なる文字はそうはいきません。
また、グループ内の文字を中に入ってひとつずつ直すのは大変です。
今でこそ簡単なスクリプトでグループ図形まま、文字の位置を直せると知っていますが、当時は
そんなことは知りませんでした。

そこで考えたのが、文字をシンボルにしてしまうことです。
シンボル内の文字をレコード・フィールドに連結しておけば、データパレットでレコード・フィー
ルドを変えるとシンボル内の文字も連動して変わります。
シンボルなので、位置の修正も一度で済みます。
というわけで、文字と基準点だけのシンボルや、文字と直線だけのシンボルを結構使いました。

*********************************************************************************

当然、丸付き番号を描くスクリプトでも、グループ図形でなくシンボルで描きたくなります。
しかし、シンボルの中の文字サイズは個別には変えられません。
では桁数によって文字サイズを変えるのは無理かというと、そんなことはありません。
桁数ごとにサイズの違う文字を用意しておき、それぞれ別のレコード・フィールドを連結すれば、
シンボル配置時に桁数に応じたフィールドに値を入れ、他のフィールドを空白にすることで、桁数
によって文字サイズを変えられます。
番号は999まであれば十分なので、1〜3桁用の文字をフィールド'1'、'2'、'3'に連結します。
お題とは関係ありませんが、
英数字なら問題なくても漢字だと潰れて見にくくなる微妙なサイズの文字は、文字を2つ用意して
漢字のほうを細いペンで描かせることも出来ました。

VectorWorksのシンボルは拡大や縮小はできませんが、形状やサイズごとにシンボルを作れば良い
ので問題ありません。
もし文字サイズを一定にして枠の大きさを変えていたら、シンボル化は無理だったでしょう。
シンボル名には直径と頂点数を入れて、シンボルを識別しやすくしました。

procedure MakeNumber3;
{ 丸付き番号を描く(シンボル版) }
{$ DEBUG}
const
__WrkSheet = 'Number-Def';
__ParameterRec = 'Number-Rec';
__ClassName = '番号';
__TxFont = 'MS ゴシック'; { 元はフォントIDで指定していた }
__Center = 2;
__VertCenter = 3; { MiniCad+では指定できなかった }
__DefaultNum = 1;
__DefaultStep = 1;
__DefaultDia = 5{m/m};
__DefaultPoly = 0; { 多角形の頂点の数= -9..-3, 0, 3..9 }
__Red = 15;
__Black = 255;
__PenWidth = 6; { (mil) }
__MaskSize = 1.1; { マスクの倍率 }
__MarkerStyle = 13; { 始点に黒丸 }
__MarkerSize = 0.04; { (inch) }
__MarkerAngle = 0; { (degree) }
__WSTextSize = 12;
__
var
__result__:boolean;
__symNm__:string;
__x0, y0, x1, y1, x2, y2, d, r, r2, scl__:real;
__c, k, step, n__:integer;
__frac, dsAcc__:longint;
__format__:integer;
__upi__:real;
__uMark, sqUMark__:string;
__
function KetaSuu(i: longint): integer; {整数の桁数を返す }
__var
____s__:string;
__begin
____s:= Num2Str(0, i);
____KetaSuu:= Len(s);
__end;{KetaSuu}
__
procedure WriteDef(i: integer); { 初期値をWSに書き込む }
__var
____h__:handle;
____f__:integer;
__begin
____TextSize(WSTextSize);
____h:= GetObject(WrkSheet);
____SelectSS(h);
____SprdFormat(1, 0, '', '');
____LoadCell(1, 2, Num2Str(0, i));
____LoadCell(1, 1, 'Index =');
__end;{WriteDef}
__
procedure SetDef(var i, st:integer; var d:real; var n:integer);
{ 初期値、増減分、直径、多角形の頂点の数を設定する }
__var
____h__:handle;
____f__:integer;
__begin
____f:= KetaSuu(frac);
____h:= GetObject(WrkSheet);
____if h = nil then begin
______i:= RealDialog('Index =', Num2Str(0, DefaultNum));
______st:= RealDialog('Step =', Num2Str(0, DefaultStep));
______d:= RealDialog('Dia(m/m) =', Num2Str(f, DefaultDia));
______n:= RealDialog('N(0:円) =', Num2Str(0, DefaultPoly));
______NewSprdSheet(WrkSheet, 0, 0, 4, 2, false, true);
______TextSize(WSTextSize);
______SprdFormat(1, 0, '', '');
______LoadCell(1, 1, 'Index ='); LoadCell(1, 2, Num2Str(0, i));
______LoadCell(2, 1, 'Step ='); LoadCell(2, 2, Num2Str(0, st));
______LoadCell(4, 1, 'N(0:円) ='); LoadCell(4, 2, Num2Str(0, n));
______SprdFormat(1, f, '', '');
______LoadCell(3, 1, 'Dia(m/m) ='); LoadCell(3, 2, Num2Str(f, d));
______h:= GetObject(WrkSheet);
____end
____else begin
______i:= GetCellNum(h, 1, 2);
______st:= GetCellNum(h, 2, 2);
______d:= GetCellNum(h, 3, 2);
______n:= GetCellNum(h, 4, 2);
____end;
____if (abs(n) < 3) | (9 < abs(n)) then begin
______n:= 0;
______SelectSS(h);
______SprdFormat(1, 0, '', '');
______LoadCell(4, 2, Num2Str(0, n));
____end;
__end;{SetDef}
__
procedure DrawPoly(x, y:real; r:real; nP:integer); { 多角形/円を描く }
__var
____i, n__:integer;
____q, a__:real;
__begin
____if nP=0 then
______Oval(x - r, y - r, x + r, y + r)
____else begin
______n:= Abs(nP);
______q:= r / Cos(Deg2Rad(180/n));
______q:= q * Sqrt(pi / n / Tan(Deg2Rad(180/n)));
______a:= 90;
______case nP of
________-9, -7, -5, -3, 4, 6, 8:
__________a:= a + 180/n;
______end;
______ClosePoly;
______BeginPoly;
______for i:= 1 to n do begin
________AddPoint(x + q*cos(Deg2Rad(a)), y + q*sin(Deg2Rad(a)));
________a:= a + 360/n;
______end;
______EndPoly;
____end;
__end;{DrawPoly}

procedure MakeSymbol(name:string; r, r2, scl:real; n:integer); { シンボルを定義する }
__
__procedure NewText(keta:integer; r:real); { Record Fieldに連結した文字を作る }
____var
______i__:integer;
______txtSize__:real;
______s__:string;
____begin
______s:= '';
______for i:= 1 to keta do
________s:= Concat(s, '0');
______txtSize:= 12 * r * 650 / ((scl * upi / 0.0254) * (0.7 + keta * 0.8));
______TextSize(txtSize);
______TextOrigin(0, 0);
______CreateText(s);
______LinkText(LNewObj, ParameterRec, Concat(keta));
____end;{NewText}
____
__begin{MakeSymbol}
____BeginSym(name);
______{ マスク }
______FillPat(1); PenSize(0);
______DrawPoly(0, 0, r2, n);
______PenSize(PenWidth);
______{ 文字 }
______FillPat(0); PenFore(Red);
______NewText(1, r);
______NewText(2, r);
______NewText(3, r);
______{ 円 }
______PenFore(Black);
______DrawPoly(0, 0, r, n);
____EndSym;
____Record(LNewObj, ParameterRec);
____Field(LNewObj, ParameterRec, '1', '');
____Field(LNewObj, ParameterRec, '2', '');
____Field(LNewObj, ParameterRec, '3', '');
__end;{MakeSymbol}
__
procedure DrawSymbol(x, y: real; symNm: string; c: integer); { シンボルを描く }
__var
____s__:string;
__begin
____s:= Num2Str(0, c);
____Symbol(symNm, x, y, 0);
____case Len(s) of
______1: Field(LNewObj, ParameterRec, '1', s);
______2: Field(LNewObj, ParameterRec, '2', s);
______otherwise
________Field(LNewObj, ParameterRec, '3', s);
____end;
__end;{DrawSymbol}
__
begin{main} { メインルーチン }
__PushAttrs;
__GetUnits(frac, dsAcc, format, upi, uMark, sqUMark);
__SetDef(c, step, d, n);
__NameClass(ClassName);
__TextFont(GetFontID(TxFont));
__TextJust(Center);
__TextVerticalAlign(VertCenter);
__Marker(MarkerStyle, MarkerSize, MarkerAngle);
__NewField(ParameterRec, '1', '', 4, 0);{ レコードやフィールドの有無を調べて条件分け }
__NewField(ParameterRec, '2', '', 4, 0);{ するのは面倒だし、重複定義してもエラーに  }
__NewField(ParameterRec, '3', '', 4, 0);{ ならないので、これで良しとする。      }
__x0:= -1234567890; y0:= x0;
__result:= true;
__while result do begin
____Message('"', c, '": 引出し線の開始位置からクリック-アンド-ドラッグしてください。');
____GetLine(x1, y1, x2, y2);
____result:= (r < Distance(x1, y1, x0, y0));
____if result then begin
______scl:= GetLScale(ActLayer);
______r:= d / 2 * scl * upi / 25.4; { 円の半径 }
______r2:= r * MaskSize; { マスクの半径 }
______symNm:= concat('Number(', n, '):', d * scl);
______if GetObject(symNm) = nil then
________MakeSymbol(symNm, r, r2, scl, n);
______DSelectAll;
______{ 引出線 }
______if distance(x1, y1, x2, y2) > r2 then begin
________PenSize(PenWidth); PenFore(Black);
________MoveTo(x1, y1);
________LineTo(x2, y2);
______end;
______{ 丸付き番号(シンボル) }
______DrawSymbol(x2, y2, symNm, c);
______ReDraw;
______c:= c + step;
______x0:= x2; y0:= y2;
____end;{if}
__end;{while}
__WriteDef(c);
__PopAttrs;
__ClrMessage;
end;{MakeNumber3}
Run(MakeNumber3);


動作確認です    管理人
Wed Nov 3 18:59:49 2010

ちょっとお邪魔します。
談話室を微妙に変更していますので、
動作確認です。


丸付き番号を描くスクリプト(2)    与太郎
Mon Nov 1 10:00:35 2010

>白黒に慣れてしまったので、カラーモニタになってからも当分は黒一色で描いていました。
と書いてるのに、
{ 文字 }
FillPat(0); PenFore(Red);
で文字を赤色に設定しているのには、最終出力がペンプロッタだったという事情があります。
MacPlotでプロッタフォントを描かせると、文字のサイズによってペンの太さを自動的に選択する
のですが、かなり大きな文字でないと太いペンで描いてくれませんでした。
それで、太いペンで描きたい文字だけ赤色にしたというわけです。
太い線を1本赤色にしておくと、赤い文字も同じペンで描いてくれるという裏技です。
寸法線も、赤色にすると文字だけ太く出来ました。

白黒モニタで色を使えるのか? と思われるかも知れませんが、
白黒〜16階調のときはVWの属性メニューのカラー項目がカラーピッカーではなく、色の名前が並
んだポップアップメニューになったので、赤い文字を選択すれば「赤」と表示されたのです。
設定するときは選択マクロで文字や寸法を選択して、一度に設定していました。
基本黒一色なので、それでも不自由には感じなかったです。
グレースケール・モニタなら、黒と赤の識別くらいは出来ましたし。

それから、元のフォントは'MS ゴシック'ではなく'中ゴシック体'に設定していました。
'中ゴシック体'ならポストスクリプト・プリンタで綺麗に速く印刷出来たからです。
その頃はプリンタをEtherNetではなくLocalTalkネットワークで接続していたので、プリンタフォ
ントでないと時間がかかり過ぎました。
中ゴシック体、細明朝体、等幅ゴシック、等幅明朝だとプリンタフォントで印刷出来ましたが、
図面ではほとんど'中ゴシック体'を使っていました。

*********************************************************************************

今回のスクリプトは、枠を円だけでなく正多角形にも出来るように改造したものです。
設定項目に多角形の頂点数を追加しています。
やたらに頂点数を増やしても円と区別がつかないので、3〜9角形までとしました。
一応ゼロを円と決めていますが、範囲外の場合も円になります。
下のように、プラスの場合は辺が真下、マイナスなら頂点が真下になります。
0・・・○
3・・・△  -3・・・▽
4・・・□  -4・・・◇

多角形のサイズは、円に外接する多角形や内接する多角形、またはその中間など色々ありますが、
外接三角形は大き過ぎるし内接三角形は小さ過ぎるので、円と等しい面積の多角形としました。

前回のスクリプトをよく見ると、
SetDef();のパラメータの直径と半径を間違えていたので、直径に直しています。
また、KetaSuu();も計算が間違っていたので、簡単な方法に変更しました。
ワークシート生成時の値がダイアログでの設定を無視していたので、それも直しました。

procedure MakeNumber2;
{ 丸付き番号を描く(円と多角形) }
{$ DEBUG}
const
__WrkSheet = 'Number-Def';
__ClassName = '番号';
__TxFont = 'MS ゴシック'; { 元はフォントIDで指定していた }
__Center = 2;
__VertCenter = 3; { MiniCad+では指定できなかった }
__DefaultNum = 1;
__DefaultStep = 1;
__DefaultDia = 5{m/m};
__DefaultPoly = 0; { 多角形の頂点の数= -9..-3, 0, 3..9 }
__Red = 15;
__Black = 255;
__PenWidth = 6; { (mil) }
__MaskSize = 1.1; { マスクの倍率 }
__MarkerStyle = 13; { 始点に黒丸 }
__MarkerSize = 0.04; { (inch) }
__MarkerAngle = 0; { (degree) }
__WSTextSize = 12;
__
var
__result__:boolean;
__x0, y0, x1, y1, x2, y2, d, r, r2, scl__:real;
__c, k, n, step__:integer;
__frac, dsAcc__:longint;
__format__:integer;
__upi__:real;
__uMark, sqUMark__:string;
__
function KetaSuu(i:longint): integer; {整数の桁数を返す }
__var
____s__:string;
__begin
____s:= Num2Str(0, Abs(i));
____KetaSuu:= Len(s);
__end;{KetaSuu}
__
procedure WriteDef(i:integer); { 初期値をWSに書き込む }
__var
____h__:handle;
____f__:integer;
__begin
____TextSize(WSTextSize);
____h:= GetObject(WrkSheet);
____SelectSS(h);
____SprdFormat(1, 0, '', '');
____LoadCell(1, 2, Num2Str(0, i));
____LoadCell(1, 1, 'Index =');
__end;{WriteDef}
__
procedure SetDef(var i, st:integer; var d:real; var n:integer);
{ 初期値、増減分、直径、多角形の頂点の数を設定する }
__var
____h__:handle;
____f__:integer;
__begin
____f:= KetaSuu(frac);
____h:= GetObject(WrkSheet);
____if h = nil then begin
______i:= RealDialog('Index =', Num2Str(0, DefaultNum));
______st:= RealDialog('Step =', Num2Str(0, DefaultStep));
______d:= RealDialog('Dia(m/m) =', Num2Str(f, DefaultDia));
______n:= RealDialog('N(0:円) =', Num2Str(0, DefaultPoly));
______NewSprdSheet(WrkSheet, 0, 0, 4, 2, false, true);
______TextSize(WSTextSize);
______SprdFormat(1, 0, '', '');
______LoadCell(1, 1, 'Index ='); LoadCell(1, 2, Num2Str(0, i));
______LoadCell(2, 1, 'Step ='); LoadCell(2, 2, Num2Str(0, st));
______LoadCell(4, 1, 'N(0:円) ='); LoadCell(4, 2, Num2Str(0, n));
______SprdFormat(1, f, '', '');
______LoadCell(3, 1, 'Dia(m/m) ='); LoadCell(3, 2, Num2Str(f, d));
______h:= GetObject(WrkSheet);
____end
____else begin
______i:= GetCellNum(h, 1, 2);
______st:= GetCellNum(h, 2, 2);
______d:= GetCellNum(h, 3, 2);
______n:= GetCellNum(h, 4, 2);
____end;
____if (abs(n) < 3) | (9 < abs(n)) then begin
______n:= 0;
______SelectSS(h);
______SprdFormat(1, 0, '', '');
______LoadCell(4, 2, Num2Str(0, n));
____end;
__end;{SetDef}
__
procedure DrawPoly(x, y:real; r:real; nP:integer);
__var
____i, n__:integer;
____q, a__:real;
__begin
____if nP=0 then
______Oval(x - r, y - r, x + r, y + r)
____else begin
______n:= Abs(nP);
______q:= r / Cos(Deg2Rad(180/n));
______q:= q * Sqrt(pi / n / Tan(Deg2Rad(180/n)));
______a:= 90;
______case nP of
________-9, -7, -5, -3, 4, 6, 8:
__________a:= a + 180/n;
______end;
______ClosePoly;
______BeginPoly;
______for i:= 1 to n do begin
________AddPoint(x + q*cos(Deg2Rad(a)), y + q*sin(Deg2Rad(a)));
________a:= a + 360/n;
______end;
______EndPoly;
____end;
__end;{DrawPoly}

begin{main}
__PushAttrs;
__GetUnits(frac, dsAcc, format, upi, uMark, sqUMark);
__SetDef(c, step, d, n);
__NameClass(ClassName);
__TextFont(GetFontID(TxFont));
__TextJust(Center);
__TextVerticalAlign(VertCenter);
__PenSize(PenWidth);
__PenFore(Black);
__Marker(MarkerStyle, MarkerSize, MarkerAngle);
__x0:= -1234567890; y0:= x0;
__result:= true;
__while result do begin
____Message('"', c, '": 引出し線の開始位置からクリック-アンド-ドラッグしてください。');
____GetLine(x1, y1, x2, y2);
____result:= (r < Distance(x1, y1, x0, y0));
____if result then begin
______scl:= GetLScale(ActLayer);
______r:= d / 2 * scl * upi / 25.4; { 円の半径 }
______r2:= r * MaskSize; { マスクの半径 }
______DSelectAll;
______{ 引出線 }
______if distance(x1, y1, x2, y2) > r2 then begin
________MoveTo(x1, y1);
________LineTo(x2, y2);
______end;
______{ 丸付き番号(グループ) }
______BeginGroup;
________k:= KetaSuu(c);
________{ マスク }
________FillPat(1); PenSize(0);
________DrawPoly(x2, y2, r2, n);
________PenSize(PenWidth);
________{ 文字 }
________FillPat(0); PenFore(Red);
________TextSize(12 * r * 650 / ((scl * upi / 0.0254) * (0.7 + k * 0.8)));
________TextOrigin(x2, y2);
________CreateText(Num2Str(0, c));
________{ 円 }
________PenFore(Black);
________DrawPoly(x2, y2, r, n);
______EndGroup;
______ReDraw;
______c:= c + step;
______x0:= x2; y0:= y2;
____end;{if}
__end;{while}
__WriteDef(c);
__PopAttrs;
__ClrMessage;
end;{MakeNumber2}
Run(MakeNumber2);


丸付き番号を描くスクリプト(1)    与太郎
Thu Oct 28 19:54:44 2010

1990年以前はパソコンといえばPC-9801で、640×400ドットの画面表示に8×16ドットの
文字を80×25行表示出来ました。
N88-BASICやアセンブラでプログラムを書いていると行数を多く表示させたくなります。
自分でも6×8の文字を68×80行(モニタ横置きで)表示するプログラムを作ってみましたが、
2バイト文字表示も文字入力も出来ない役立たずでした。
当時はろくにサブルーチン化もしていない、読みにくいプログラムばかり書いていたのは
間違いありません。印刷したものを見ないとデバッグもできませんでした。
(今はプログラムのソースを印刷することなんてありません。)
ですから、Turbo Pascalでは8×8のフォントで80×50行の表示出来たのは嬉しかったです。
日本語は潰れて見えないし、表示は遅かったですけど。

Macintoshを使い始めたきっかけも、小さな文字で表示できることでした。
といってもClassicの画面は512×342ドットで、メニューバーやウィンドウ枠もあるので、
DOSの標準画面より何行か余計に表示出来た程度でした。
当然すぐに大きなモニタが欲しくなって、LCを買ってしまいます。
最初のモニタは12インチのグレースケールモニタで640×480ドット表示なので全然大きく
ないですが、次に買った16インチのマルチスキャンモニタは1152×870ドット表示が出来
ました。これは2-Page Displayと同じ解像度なので、掛け値なしに大きいと言えます。
(Apple謹製の2-Page Displayは21インチの巨大モニタでした。)
もっとも、これを買ったのはテキスト表示が目的じゃなくて、CADを快適に使うためです。

MacでCADを始めるにあたって、価格的にClaris CADとMiniCAD+の2つが候補でした。
Claris CADはガイド本も買って読んで、操作性はよさそうだったのですが、
結局はワークシートとマクロ(スクリプト)に惹かれてMiniCAD+に決めました。
(AutoCADのMac版もありましたが、50万円くらいしました。)

MiniCAD+で気に入ったことの1つが、印刷時と同じように線の太さを表示できることです。
カラーモニタがなかったので、そうでないと使い物にならなかったとも言えますが。
白黒に慣れてしまったので、カラーモニタになってからも当分は黒一色で描いていました。
太さを1、3、6、11、21(ミル)にすると、
100%表示では21ミルの線だけ2ドット幅で表示され、
200%表示では21ミルが4ドットで11ミルが2ドット、
400%表示では21ミルが8ドットで11ミルが4ドットで6ミルが2ドット、
800%表示では21ミルが16ドットで11ミルが8ドットで6ミルが4ドットで3ミルが2ドット、
というように表示されて見やすかったです。
線の太さを表示しておくと、印刷すると潰れて見えなくなるような細部まで描くことがな
くなるというメリットもあります。
1/100では幅が15ミリの平行線は、寸法どおりではなく間隔を50ミリくらいで描かないと
2本の線に見えませんが、そういうことも画面で判ります。

文字サイズがポイント指定なので、縮尺や単位が変わっても関係ないのも利点です。
例えばAutoCADで1/500の図面に3ミリの文字を入れるときは3×500なので高さを1500ミリに、
1/200なら600ミリにしなければなりませんが、MiniCAD+なら11ポイントで決まりです。
印刷すると見えないような小さな文字を書いてしまうことも、ポイント指定ならありません。

*********************************************************************************

丸付き番号を描くスクリプトは何度も話題になっています。
必要だが他人の作ったものはそのまま使いたくないというこだわりがそうさせるのしょうか。
そういう与太郎も(何度も)自作しました。
与太郎のこだわりは円の大きさです。
縮尺や単位に関係なく、5ミリとか10ミリとかの決まった大きさで描かせたい。
手書きではテンプレートで同じ大きさの円を描いてから数字を入れるので、スクリプトでも印刷
時の円の大きさを指定して描きたかったのです。
文字サイズに円を合わせても縮尺や単位に関係なく描けますが、それだと番号の桁数によって円
の大きさが変わってしまいます。

今回のスクリプトはMiniCadでマクロを書き始めた頃に作ったものです。
そのままではVWで実行できないので、ワークシートとマーカー関連は修正が必要でした。
また、書式と変数名等も直していますが、基本的な構造は元のままです。
この頃はハンドルをあまり理解してなかったので、ほとんど使っていません。
ワークシートとレイヤ縮尺で仕方なく使った記憶があります。

仕様は以下のようなものです。
1. 引出線の先端から円の中心までドラッグして、引出線付きの丸付き番号を描く。
2. 直前に描いた丸付き番号の上でクリックすると終了。
3. 円の大きさは印刷時のサイズを指定し、縮尺や単位に依存しない。
4. ペンプロッタで文字だけ太くするために、文字の色を変える。
5. 文字の大きさは、円に収まるように桁数によって変える。
6. 背景に埋没しないように、円の外側に余白を付ける。
7. クラスは「番号」に設定する。
8. 番号の初期値がスクリプト実行のたびにリセットされないようにする。

1、2、4、7 は問題無いとして、
3 は、円のサイズをUPI(Unit Par Inch)とアクティブレイヤの縮尺を調べて計算します。
5 は、図形の大きさを調べる方法が判らなかったので、文字サイズは怪しげな計算で決めています。
MiniCadでは文字の垂直方向の基点を真中に出来なかったので、元のスクリプトでは文字のY座標も
計算で出してました。
6 は、一番背面にマスクとなる円を輪郭無しで描けば良いのですが、
グループ化すると引出線を一番背面にするしかなく、円と引出線の間に隙間が出来てしまいます。
でも、じっくり見なければ気にならないので無視しています。
8 は、スクリプトを終了したら変数も消えてしまうので、初期値はワークシートに書き込んでいま
すが、今だったらレコードを使うでしょう。
テキストファイルに書き出すほうが簡単なのにそうしなかった理由は、初回以降はダイアログを開
かずに済ませるためと、ファイルごとに初期値を変えられるほうが良いと思ったからです。

procedure MakeNumber1;
{ 丸付き番号を描く(原型) }
{$ DEBUG}
const
__WrkSheet = 'Number-Def';
__ClassName = '番号';
__TxFont = 'MS ゴシック'; { 元はフォントIDで指定していた }
__Center = 2;
__VertCenter = 3; { MiniCad+では指定できなかった }
__DefaultNum = 1;
__DefaultStep = 1;
__DefaultDia = 5{m/m};
__Red = 15;
__Black = 255;
__PenWidth = 6; { (mil) }
__MaskSize = 1.1; { マスクの倍率 }
__MarkerStyle = 13; { 始点に黒丸 }
__MarkerSize = 0.04; { (inch) }
__MarkerAngle = 0; { (degree) }
__WSTextSize = 12;
__
var
__result__:boolean;
__x0, y0, x1, y1, x2, y2, d, r, r2, scl__:real;
__c, k, step__:integer;
__frac, dsAcc__:longint;
__format__:integer;
__upi__:real;
__uMark, sqUMark__:string;
__
function KetaSuu(i: longint): integer; {整数の桁数を返す }
__var
____result__:integer;
__begin
____result:= 0;
____while i >= 10 do begin
______i:= i div 10;
______result:= result + 1;
____end;
____KetaSuu:= result;
__end;{KetaSuu}
__
procedure WriteDef(i: integer); { 初期値をWSに書き込む }
__var
____h__:handle;
____f__:integer;
__begin
____TextSize(WSTextSize);
____h:= GetObject(WrkSheet);
____SelectSS(h);
____SprdFormat(1, 0, '', '');
____LoadCell(1, 2, Num2Str(0, i));
____LoadCell(1, 1, 'Index =');
__end;{WriteDef}
__
procedure SetDef(var i, step: integer; var r: real); { 初期値、増減分、半径を設定する }
__var
____h:__handle;
____d:__real;
____f:__integer;
__begin
____f:= KetaSuu(frac);
____h:= GetObject(WrkSheet);
____if h = nil then begin
______i:= RealDialog('Index =', Num2Str(0, DefaultNum));
______step:= RealDialog('Step =', Num2Str(0, DefaultStep));
______d:= RealDialog('Dia(m/m) =', Num2Str(f, DefaultDia));
______NewSprdSheet(WrkSheet, 0, 0, 4, 2, false, true);
______TextSize(WSTextSize);
______SprdFormat(1, 0, '', '');
______LoadCell(1, 1, 'Index =');
______LoadCell(1, 2, '1');
______LoadCell(2, 1, 'Step =');
______LoadCell(2, 2, '1');
______SprdFormat(1, f, '', '');
______LoadCell(3, 1, 'Dia(m/m) =');
______LoadCell(3, 2, Num2Str(f, d));
____end
____else begin
______i:= GetCellNum(h, 1, 2);
______step:= GetCellNum(h, 2, 2);
______d:= GetCellNum(h, 3, 2);
____end;
____r:= d / 2;
__end;{SetDef}
__
begin{main}
__PushAttrs;
__GetUnits(frac, dsAcc, format, upi, uMark, sqUMark);
__SetDef(c, step, d);
__NameClass(ClassName);
__TextFont(GetFontID(TxFont));
__TextJust(Center);
__TextVerticalAlign(VertCenter);
__PenSize(PenWidth);
__PenFore(Black);
__Marker(MarkerStyle, MarkerSize, MarkerAngle);
__x0:= -1234567890; y0:= x0;
__result:= true;
__while result do begin
____Message('"', c, '": 引出し線の開始位置からクリック-アンド-ドラッグしてください。');
____GetLine(x1, y1, x2, y2);
____result:= (r < Distance(x1, y1, x0, y0));
____if result then begin
______scl:= GetLScale(ActLayer);
______r:= d * scl * upi / 25.4; { 円の半径 }
______r2:= r * MaskSize; { マスクの半径 }
______DSelectAll;
______{ 引出線 }
______if distance(x1, y1, x2, y2) > r2 then begin
________MoveTo(x1, y1);
________LineTo(x2, y2);
______end;
______{ 丸付き番号(グループ) }
______BeginGroup;
________k:= KetaSuu(c);
________{ マスク }
________FillPat(1); PenSize(0);
________Oval(x2-r2, y2-r2, x2+r2, y2+r2);
________PenSize(PenWidth);
________{ 文字 }
________FillPat(0); PenFore(Red);
________TextSize(12 * r * 650 / ((scl * upi / 0.0254) * (1.7 + k * 0.8)));
________TextOrigin(x2, y2);
________CreateText(Num2Str(0, c));
________{ 円 }
________PenFore(Black);
________Oval(x2-r, y2-r, x2+r, y2+r);
______EndGroup;
______ReDraw;
______c:= c + step;
______x0:= x2; y0:= y2;
____end;{if}
__end;{while}
__WriteDef(c);
__PopAttrs;
__ClrMessage;
end;{MakeNumber1}
Run(MakeNumber1);

どうして整数型の変数が「c」かというと、counterの頭文字です。
ちなみに86系CPUのCXレジスタはカウンタ用で、ループ回数などを記憶します。
でも、Pascalなどの高級言語ではinteger型は「i」が普通ですね。indexの頭文字でもあるし。

scl:= GetLScale(ActLayer);
r:= d * scl * upi / 25.4; { 円の半径 }
r2:= r * MaskSize; { マスクの半径 }
の3行は、元々は SetDef(c, step, d); の下にあって、最初に1回実行されるだけだったのですが、
テストしてるとき、コマンド実行中もアクティブレイヤを変更出来ることに気付いてしまったので、
ループの中に移動しました。


お引っ越し    管理人
Wed Oct 27 20:59:59 2010

迷惑書き込み発生のためこちらに引っ越しました。
直リンクの方はお手数ですが、変更をお願いします。


Re^2:カラーレイヤのオンオフ切り替え(2008 で作成)    ゴンスケ
Fri Oct 15 16:11:48 2010

与太郎さん、アドバイスありがとうございます。

> 変数やループ処理が無いものなら、Procedureの羅列でOKです。

よく分かりました、、、というか、お恥ずかしい、というか、、、。


Re:カラーレイヤのオンオフ切り替え(2008で作成)    与太郎
Fri Oct 15 11:56:31 2010

じつはこれ、SetPref(11, NOT(GetPref(11))); だけでも実行出来ます。
いわゆる1行スクリプトです。
変数やループ処理が無いものなら、Procedureの羅列でOKです。
古いバージョンのVectorScriptファイルもそういう仕様でした。

私自身はカラーレイヤはめったに使いませんが、「拡大時に線の太さを表示」は欠かせません。
印刷時には「白黒表示」にする必要があるし、AutoCadのファイルは「背景を黒」にしないと見にくい。
ですから、これらのコマンドはプラグイン・メニューにしています。


カラーレイヤのオンオフ切り替え(2008で作成)    ゴンスケ
Fri Oct 15 11:15:37 2010

頻繁にカラーレイヤのオンオフを切り替える作業が必要になったため作った小物です。与太郎さん、石男さんのレベルとはほど遠いんです が、、、、備忘録を兼 ねている
ブログのシステム更新中なので、こっちにアップしてみます(管理人さん、失礼!)。

//////////
PROCEDURE SwitchLayerColorsSetting;
BEGIN
SetPref(11, NOT(GetPref(11)));
END;
RUN(SwitchLayerColorsSetting);
//////////

SetPref, GetPrefのパラメータ(この場合、環境設定の項目)を変えれば、
いろいろできますね。たとえば、「拡大時に線の太さを表示」のオンオフは、
上の2箇所の「11」を「9」にすればOK。

環境設定の項目番号は、VectorScript 2008 Function Reference の「付録」の
Appendix F に一覧が掲載されています。



Re.2:原点とシンボルについて(次回予告)    与太郎
Wed Oct 13 17:26:58 2010

石男さんは御承知でしょうけど、
プラグイン・オブジェクトでの原点の扱いも、アレレっと思う点がいくつかあります。


Re.:原点とシンボルについて    石男
Wed Oct 6 16:05:28 2010

2010にて3D多角形と柱状体からなる3Dシンボル、簡単な2Dシンボルで試したところ、与太郎
さんのご指摘通りのバグを確認しました。

確かにシンボル内の座標は、シンボル挿入点が原点であるべきです。
誰も指摘していないんでしょうね。


原点とシンボルについて    与太郎
Wed Oct 6 9:09:52 2010

原点を移動した場合、元の原点位置はGetOriginで調べます。
ほとんどのサブルーチンでは原点を移動していても問題ないのですが、
3D多角形の頂点は、XとYの値からGetOriginで求めた値を引かないと実際の座標になりません。

また、シンボル内で図形を生成する場合はシンボル挿入点が基準(0, 0)でいいのですが、
シンボル内の図形の座標を取得する場合は原点の移動量を考慮する必要があります。
つまり、原点の移動量を加算した値が返って来るのですが、これは納得しがたい仕様です。
シンボル内の座標は、原点位置に関係なく、シンボル挿入点が(0, 0)であるべきです。

MiniCADの頃からデータバーとデータパレットには原点の移動量を加算した座標が表示されていましたが、
Ver.9以降では、データパレットにはシンボル挿入点を基準にした値が表示されるように変わっています。
ついでにデータバーのほうも直せば良かったのに。

Ver.11.5より新しいバージョンでは確認していませんが、
シンボル内の座標については、VectorScriptファイルの書き出しにバグがあります。
原点の移動量を加算した値を吐き出してしまうので、読み込むとシンボルの位置がずれたようになります。
実際は、シンボルの位置ではなく、シンボル内の図形の位置がずれているのですが。
しかし、このバグがずっとそのままだったということは、誰も指摘しなかったということでしょうね。
私自身、気付いたのは最近でしたが、今更Ver.11.5のバグなんて直らないからどこにも報告しません。

VectorScriptファイルを読み込んでシンボルがずれていたら、元のファイルで原点を移動しているはずです。
シンボル(内の図形)のずれを直すには、以下のスクリプトを実行します。

procedure RestoreSymbols;
const
SymDef = 16;
var
i:integer;
hSym, h:handle;
x0, y0:real;
name:string;
begin
GetOrigin(x0, y0);
for i:= 1 to NameNum do begin
name:= NameList(i);
if (name <> '') & (name <> 'None') then begin
hSym:= GetObject(name);
if (hSym <> nil) & (GetType(hSym) = SymDef) then begin
h:= FInSymDef(hSym);
while h <> nil do begin
HMove(h, x0, y0);
h:= NextObj(h);
end;
end;
end;
end;
ReDrawAll;
end;
Run(RestoreSymbols);

上のスクリプトは、新規ファイルにVectorScriptファイルを取り込んだ状態で実行してください。
取り込む前にシンボルが存在していると、そのシンボルの中の図形も移動してしまいます。
実行するたびに逆方向にずれていくので、1回しか実行しないでください。


Ver.11以降のVectorScriptファイルの読み書きについて    与太郎
Thu Sep 30 17:09:47 2010

Ver.11でVectorScriptファイルの書き出しに変更があって、
レイヤ指定が Layer('レイヤ名'); から layerHandle := CreateLayer('レイヤ名', 1); に変わっています。
(以前のバージョンでは関数/手続きの羅列だったのが、Pascalの文法に則った書式に変更されています。)

これは、オプションでデザインレイヤとシートレイヤを区別するために必要な変更だったと思いますが、
既存ファイルにVectorScriptファイルを取り込んでマージする場合に支障があります。
例えば、Layer('レイヤ名'); の場合は同じ名前のレイヤがあるとそのレイヤがアクティブになるだけですが、
layerHandle := CreateLayer('レイヤ名', 1); ではレイヤ名が重複していると別名で新しいレイヤを作ります。
これではマージ出来ません。

ですから、マージをしたいときは、
layerHandle := CreateLayer('レイヤ名', 1); を Layer('レイヤ名'); に書き換える必要があります。

これで困るのは、置換にワイルドカードが使えないエディタだと一括変換が出来ないことです。
CreateLayer(1, 'レイヤ名'); だったら Layer('レイヤ名'); に簡単に一括変換出来たんですけどね。
「CreateLayer」で検索して1個づつ直すとしても、レイヤなんて普通は数十個程度だから、たいした手間では
ないと言えばそれまでですが、Script談話室的には一工夫したいものです。

そこで、コピペと置換えだけでマージが出来るように修正する方法を考えてみます。

まず、ファイル内の「CreateLayer」を「SetActLayer」に一括変換します。
そのままだと関数SetActLayerの未定義エラーになるので、ファイルの最初の方の、

BEGIN
{VectorWorks Version *******}

の前(メインルーチンの直前の位置)に、下のSetActLayer関数の定義を挿入(コピペ)します。

function SetActLayer(name:string; tp:integer):handle;
var
result:handle;
begin
if tp = 1 then begin
Layer(name);
result:= ActLayer;
end
else begin
result:= CreateLayer(name, tp);
end;
SetActLayer:= result;
end;{SetActLayer}

以上の作業の後、ファイルを保存してVectorWorksで読み込めば、ちゃんとマージされるはずです。

もし間違えて、最初に関数SetActLayerの定義を挿入してから「CreateLayer」を「SetActLayer」に置換えると、
SetActLayer関数の中のCreateLayerもSetActLayerに置き換わってしまいます。
そのまま取り込むと、シートレイヤ生成の行でSetActLayerが永遠に呼び出されるのでVectorWorksはフリーズし、
最後にはメモリ不足で強制終了することになります。
そうなると当然、未保存のデータは失ってしまいます。

出口のない再帰プログラムの落とし穴です。
システムではなくVectorWorks側で対処して、スクリプトを強制終了してくれたら心配ないんですけどね。
挙動の判らないスクリプトを実行するときは必ず全てのファイルを保存してください。

上ではデザインレイヤだけマージしていますが、シートレイヤもマージしたいのなら下のようになります。

function SetActLayer(name:string; tp:integer):handle;
begin
Layer(name);
SetActLayer:= ActLayer;
end;{SetActLayer}

とっても簡単です。
頭の良いコンパイラなら、パラメータのtpが使われていないと文句を言うかもしれませんが、
VectorWorksはそんなお節介はしないので問題ありません。

Ver.11より前のバージョンにはCreateLayerがないので、
新しいバージョンのVectorScriptファイルを読み込むとエラーになります。
その場合は下のようにCreateLayer関数を定義します。

function CreateLayer(name:string; tp:integer):handle;
begin
Layer(name);
CreateLayer:= ActLayer;
end;{CreateLayer}

これだとシートレイヤも普通のレイヤとして生成されますが、どうせビューポート関係でエラーになるので、
ファイルを確認しながら不要な行を消す必要があるから、余計なことはしませんでした。


Re^2:拾い物の品定め    江戸の黒板当番
Fri Sep 24 13:09:05 2010

早速調べていただきありがとう御座いました。

かなり古いバージョンのものだったのすが
Worksheet関係のものってなかなか少ないのと
スクリプトもよく分からないのでどんなもんかと
思っていました。

最新バージョンだと動いているのかどうか
何となく分らないというのが感想なんですよ。


Re:拾い物の品定め    与太郎
Wed Sep 22 18:06:25 2010

名前を付けた全ての図形の面積を、"Area Worksheet"という(もし無ければ別の)
ワークシートに書き出すスクリプトですね。
11.5だと問題なく動きます。
期限切れの関数は使ってないので、最新バージョンでも大丈夫なんじゃないでしょうか。

面積だけならワークシートのDB機能でも書き出せますが、図形の名前は返せないので、
これはワークシート単体では出来ないことを実現したスクリプトと言えます。
名前ではなくレコードフィールドの値(文字列)を使えばDB機能だけで出来るけど、
名前と違ってレコードフィールドだと複数の図形に同じ値(名前)が付けられるので、
まったく同じとは言えません。

ただ、このスクリプト自体はチェックが甘くて、図形を消して再実行すると下のほうの
行に前の結果が残っていたり、行数が足らなくてもエラーを出すだけだったりするので、
少しお色直しすると良いかも知れません。
でも、応用すると色々面白いことが出来そうです。

>はたまた、こんな機能はもう付いてますよとかの判断していただきたいのですが
これは誰か最新版を持ってる人にお願いしましょう。


拾い物の品定め    江戸の黒板当番
Wed Sep 22 9:49:20 2010

NNAのサイトにかなり古いバージョンのFreeスクリプトがありまして
まあ,今のバージョンで使えるものなのか?
はたまた、こんな機能はもう付いてますよとかの判断していただきたいのですが
挑戦していただけませんか?


_______________________________________

PROCEDURE UpDateWorksheet;
LABEL 1;
CONST
kSpaceSymName = 'Space Name Box';
kRelationSymName = 'Relationship Box';
kWorksheetName='Area Worksheet';
kWorksheetTextSize = 10;
kWorksheetFont = 3;
kSpaceRec = 'Space';
kSpaceFld = 'Name';
kAdjacentRec = 'Adjacency';
kAdjacentFld = 'Code';
VAR
WSH : HANDLE;
startRow,numRows,numCols,numNames,r1,r2,i,c : INTEGER;
str,worksheetName,spaceName : STRING;
doAlert1,doAlert2 : BOOLEAN;

PROCEDURE ProcessNames(han : HANDLE);
LABEL 2;
VAR
emptyRow: BOOLEAN;
str1,str2,str3: STRING;
a1:REAL;

BEGIN
{** Reject if not a named object}
str1:= GetName(han);
IF (str1 = 'none') THEN GoTo 2;
a1:= HArea(han);

{** Reject if area is 0}
IF (a1 = 0) THEN GoTo 2;
str3:= Num2Str(2,a1);

{** Find valid named object in worksheet}
{** If match found then load actual area}
FOR r1:= startRow TO numRows DO
BEGIN
str2:= GetCellStr(WSH,r1,1);
IF (str1 = str2) THEN
BEGIN
LoadCell(r1,3,str3);
GOTO 2;
END;
END;

{** If we got here then there is a space on drawing not listed in worksheet}

{** Find an empty row}
{** If empty row found then load name and actual area}
{** If no empty rows found then set alert flag for end of procedure}
FOR r2:= startRow TO numRows DO
BEGIN
emptyRow:= TRUE;
FOR c:= 1 TO numCols DO IF CellHasStr(WSH,r2,c) THEN emptyRow:= FALSE;

IF emptyRow THEN
BEGIN
LoadCell(r2,3,str3);
LoadCell(r2,1,str1);
GoTo 2;
END;

IF r2 = numRows THEN
BEGIN
doAlert1:= TRUE;
GoTo 2;
END;
END;
2:END;

BEGIN
PUSHATTRS;
TextFont(kWorksheetFont);
TextSize(kWorksheetTextSize);
doAlert1:= FALSE;
{** Try named worksheet CONST}
WSH:=GETOBJECT(kWorksheetName);
{** Try active worksheet}
IF (WSH=NIL) THEN WSH:=ActSSheet;
{** Try getting worksheet name from user}
IF (WSH=NIL) THEN BEGIN
worksheetName:=STRDIALOG('Enter the name of the worksheet to be sorted.','Worksheet 1');
WSH:=GETOBJECT(worksheetName);
END;
{** If no worksheet then punch out with dialogノ}
IF ((WSH=NIL)|(GetType(WSH)<>18)) THEN BEGIN
SYSBEEP;
ALRTDIALOG('I canユt find a worksheet by that name.');
GOTO 1;
END;
SelectSS(WSH);
SprdSize(WSH,numRows,numCols);
IF GETCELLSTR(WSH,1,1) = 'Name' THEN startRow:= 2
ELSE startRow:= 1;
IF GETCELLSTR(WSH,1,1) = '' THEN startRow:= 2;

FOREACHOBJECT(ProcessNames,V);

IF doAlert1 THEN
BEGIN
ALRTDIALOG('Some new spaces were skipped. Insert blank row(s) and run the ヤUpdate Worksheetユ command again.');
END;

{CLRMESSAGE;}
1:POPATTRS;
END;
RUN(UpDateWorksheet);


Re2:レコードのフィールド    石男
Tue Sep 7 11:26:20 2010

>与太郎さま
DelObject(GetObject(レコード名));でレコード定義自体の削除できました。

レコード定義自体は検索出来るので気づくべきでした(笑)さすがです。
>特定のフィールドを消すことは... 出来そうにないです。
これは無理のようです。フィールドのハンドルがないんですから...。

mlのアーカイブを見ても、レコード定義自体の削除はできないってなっていたので...。


Re:レコードのフィールド    与太郎
Tue Sep 7 9:00:06 2010

試してないですが、
DelObject(GetObject(レコード名)); で、レコード定義自体は削除出来ませんか?
同じ方法でシンボルやシンボルフォルダは消せるようです。

特定のフィールドを消すことは... 出来そうにないです。


レコードのフィールド    石男
Mon Sep 6 20:52:15 2010

スクリプトでレコードやそのフィールドそのものを削除する方法ってありますか?

DelRecord( h:HANDLE; name:STRING );はハンドルで指定した図形に連結されているレコード
を削除しますといっているが、連結を切るだけみたいですし、その他は見当たらないので
す。


LNewObjでNILが返って来ない    与太郎
Tue Aug 24 19:30:03 2010

スクリプトで直線を描くとき単純に、

MoveTo(x1, y1);
LineTo(x2, y2);
hLn1:= LNewObj;
if hLn1 = NIL then begin

とやったりしますが、思いがけないバグで悩むことがあります。
上の例でいうと、
もし始点と終点が同じ座標だったら直線は生成されません。
そのためにハンドルがNILかどうか調べて直線が出来たかどうか判断しているのですが、
たとえハンドルがNILでなかったとしても直線が生成出来たとは限りません。
スクリプト内で既に図形を生成していたら、直線の生成に失敗してもNILは返ってきません。
その場合、直前に生成した図形のハンドルが返って来るからです。

MoveTo(x1, y1); LineTo(x2, y2); hLn1:= LNewObj;
MoveTo(x2, y2); LineTo(x3, y3); hLn2:= LNewObj;
if hLn1 <> NIL then HMove(hLn1, dX, dY);
if hLn2 <> NIL then HMove(hLn2, dX, dY);

上の例では(x2, y2)と(x3, y3)が同じ座標だった場合、
直線は生成されないのでhLn2はNILになると想定しているのですが、
実際にはLNewObjはNILでなく、hLn1と同じ値を返します。
つまり、hLn1とhLn2は同じ図形を指しています。
そのため最初に出来た直線はHMoveを2回実行されてしまうので、考えていた距離の2倍移動してしまいます。
2つの直線の生成や移動が別々のところに書かれていたら、原因に中々気付かないかも知れません。
正しくは、下のようにする必要があります。

if EqualPt(x1, y1, x2, y2) then hLn1:= NIL
else begin
__MoveTo(x1, y1); LineTo(x2, y2); hLn1:= LNewObj;
end;
if EqualPt(x2, y2, x3, y3) then hLn2:= NIL
else begin
__MoveTo(x2, y2); LineTo(x3, y3); hLn2:= LNewObj;
end;
if hLn1 <> NIL then HMove(hLn1, dX, dY);
if hLn2 <> NIL then HMove(hLn2, dX, dY);

始点と終点が一致していれば直線は生成されないので、最初に始点と終点の座標をチェックしています。
もう1つの方法は、直前のLNewObjの値と新しい値を比べ、同じなら新しい図形が生成されなかったと判断して
NILハンドルを返すというものです。

h0:= LNewObj;
MoveTo(x1, y1); LineTo(x2, y2); hLn1:= LNewObj;
if h0 = hLn1 then hLn1:= NIL;
h0:= LNewObj;
if h0 = hLn2 then hLn1:= NIL;
MoveTo(x2, y2); LineTo(x3, y3); hLn2:= LNewObj;
if hLn1 <> NIL then HMove(hLn1, dX, dY);
if hLn2 <> NIL then HMove(hLn2, dX, dY);

上の方法は図形の種類によって処理を変える必要がないので楽なのですが、余計な変数が必要です。
どちらにしろ簡潔なスクリプトとは言えないので、直線生成を関数にしてみます。

function NewLine(x1, y1, x2, y2:real):handle;
var
__h, h0__:handle;
begin
__h0:= LNewObj;
__MoveTo(x1, y1); LineTo(x2, y2); h:= LNewObj;
__if h = h0 then h:= NIL;
__NewLine:= h;
end;{NewLine}

この関数を使うと下のようになります。

hLn1:= NewLine(x1, y1, x2, y2);
hLn2:= NewLine(x2, y2, x3, y3);
if hLn1 <> NIL then HMove(hLn1, dX, dY);
if hLn2 <> NIL then HMove(hLn2, dX, dY);

場合によっては、下のように生成図形の有無を返したほうが使いやすいかも知れません。

function CreateLine(x1, y1, x2, y2:real; var h:handle):boolean;
var
__h, h0__:handle;
begin
__h0:= LNewObj;
__MoveTo(x1, y1); LineTo(x2, y2); h:= LNewObj;
__if h = h0 then h:= NIL;
__CreateLine:= (h <> NIL); {if h <> NIL then CreateLine:= True else CreateLine:= False;}
end;{CreateLine}

図形生成の有無で処理を変える場合は、下のように簡潔に書けます。

if CreateLine(x1, y1, x2, y2, hLn1) then HMove(hLn1, dX, dY);
if CreateLine(x2, y2, x3, y3, hLn2) then HMove(hLn2, dX, dY);

円弧の長さがゼロだったり、四角形の面積がゼロだったり、文字図形が空の場合なども図形は生成されません。
そういうケースは決して珍しくないので、図形生成は出来るだけ関数化したほうが良いと思います。


Re.4:ベクトル計算などナド    与太郎
Wed Aug 18 1:24:13 2010

>石男さん
私自身、今回初めて使い方を知ったんです。
今までは、元のベクトルを回転して基準になる角度に垂直な成分と平行な成分に分けて、
ごちゃごちゃやって元の角度に戻してました。
これからはCompを使おうと思います。

マニュアルで図解してあったら、もっと前から使ってたんですけどねぇ。


Re.3:ベクトル計算などナド    石男
Tue Aug 17 21:15:19 2010

>与太郎さん
サンプルまで出していただきありがとうございました。
ようやく、理解できました。これこそ、ずっとサンプルないのかな?と思っていました。


Re.2:ベクトル計算などナド    与太郎
Tue Aug 17 9:32:25 2010

下のスクリプトで理解出来るでしょうか。>Comp

ボールが壁にぶつかったり、光が表面で反射/屈折するときの計算に使えます。

procedure CompTest;
label
999;
var
v1, v2, v3, v4, p11, p12, p21, p22:vector;
h1, h2:handle;
begin
PushAttrs;
FillPat(1);
FillFore(0);
TextSize(12);
TextJust(2);
TextVerticalAlign(3);
Marker(2, 0.15{inch}, 15{deg});

Message('元のベクトル(v1)を引いて下さい。');
GetLine(p11.x, p11.y, p12.x, p12.y);
v1:= p12 - p11;
if Norm(v1) = 0 then begin
AlrtDialog('元のベクトル(v1)がありません。');
GoTo 999;
end;
MoveTo(p11.x, p11.y); LineTo(p12.x, p12.y);
TextOrigin(p11.x + v1.x/2, p11.y + v1.y/2);
CreateText('V1');
DSelectAll;
ReDrawAll;

Message('基準となるベクトル(v2)を引いて下さい。');
GetLine(p21.x, p21.y, p22.x, p22.y);
v2:= p22 - p21;
if Norm(v2) = 0 then begin
AlrtDialog('基準となるベクトル(v2)がありません。');
GoTo 999;
end;
MoveTo(p21.x, p21.y); LineTo(p22.x, p22.y);
SetLS(LNewObj, -2);
TextOrigin(p21.x + v2.x/2, p21.y + v2.y/2);
CreateText('V2');

Comp(v1, v2, v3, v4);
PenFore(15);
if Norm(v3) <> 0 then begin
MoveTo(p11.x, p11.y); Line(v3.x, v3.y);
TextOrigin(p11.x + v3.x/2, p11.y + v3.y/2);
CreateText('V3');
end;
if Norm(v4) <> 0 then begin
MoveTo(p11.x, p11.y); Line(v4.x, v4.y);
TextOrigin(p11.x + v4.x/2, p11.y + v4.y/2);
CreateText('V4');
end;
DSelectAll;
ReDrawAll;
999:
PopAttrs;
end;
Run(CompTest);


Re.:ベクトル計算などナド    石男
Sun Aug 15 22:56:30 2010

与太郎さんのカキコに触発されて、ベクトル演算を改めて試してみました。
VS Language Guideにはベクタ型はベクトル演算が出来るというだけで、具体的なことが
何一つ書いてありませんでした...
a, b, c : VECTOR;
c := a+b;-----------ベクトルの加法
c := a-b;-----------ベクトルの減法

a, b : VECTOR; m : REAL;
b := m*a;-----------ベクトルの実数倍
各成分での計算は
( b.x, b.y, b.z ) = m*( a.x, a.y, a.z ) = ( m*a.x, m*a.y, m*a.z )

a, b : VECTOR; value : REAL;
value := a・b;-----------「・」を使っての内積計算
value := DotProduct( a, b );-----------関数での計算
内積は上の2通りが出来る

a, b, c : VECTOR;
c := a*b;-----------「*」を使っての外積計算
c := CrossProduct( a, b );-----------関数での計算
外積も上の2通りが出来る

ベクトルの説明はいらないけど、どんな演算が出来るのかぐらいの説明は欲しいです。
Comp( v1, v2 :VECTOR; VAR v3, v4 :VECTOR );の使い方が分からないのは、わたしだけ
でしょうか?





ベクトル計算などナド    与太郎
Wed Aug 11 11:01:25 2010

ベクトル(v)に別のベクトル(1.5, -2.5)を足すときは、

v.x:= v.x + 1.5;
v.y:= v.y - 2.5;

か、あるいは

v2.x:= 1.5;
v2.y:= -2.5;
v:= v + v2;

とするしかないですが、XとYの値からベクトルを返す関数 XY2Vec を作ってやれば

v:= v + XY2Vec(1.5, -2.5);

のように1行で書けます。

ベクトル(v)を角度(rot)で回転したい場合は通常は

ang:= Vec2Ang(v);
lng:= Norm(v);
v:= Ang2Vec(ang + rot, lng);

か、

v:= Ang2Vec(Vec2Ang(v) + rot, Norm(v));

となりますが、ベクトルを回転する関数 RotVec を作って

v:= RotVec(v, rot);

と書くことも出来ます。

ベクトル(1.5, -2.5)を角度(rot)で回転したい場合は

v.x:= v.x + 1.5;
v.y:= v.y - 2.5;
v:= Ang2Vec(Vec2Ang(v) + rot, Norm(v));

と、3行になりますが、これも

v:= RotVec(XY2Vec(1.5, -2.5), rot);

のように1行に出来ます。

直線(h)を任意の点(x, y)を基準にして回転する場合は、

v0.x:= x;
v0.y:= y;
GetSegPt1(h, v1.x, v1.y);
GetSegPt2(h, v2.x, v2.y);
v1:= v0 + Ang2Vec(Vec2Ang(v1-v0) + rot, Norm(v1-v0));
v2:= v0 + Ang2Vec(Vec2Ang(v2-v0) + rot, Norm(v2-v0));
SetSegPt1(h, v1.x, v1.y);
SetSegPt2(h, v2.x, v2.y);

と、8行になります。
XY2Vec と RotVec を使えば、

v0:= XY2Vec(x, y);
GetSegPt1(h, v1.x, v1.y);
GetSegPt2(h, v2.x, v2.y);
v1:= v0 + RotVec(v1-v0, rot);
v2:= v0 + RotVec(v2-v0, rot);
SetSegPt1(h, v1.x, v1.y);
SetSegPt2(h, v2.x, v2.y);

になります。
もっと短くしたければ、直線の端点をベクトルで返す関数 GetStartPtV と GetEndPtV を作って、

v0:= XY2Vec(x, y);
v1:= v0 + RotVec(StartPtV(h) - v0, rot);
SetSegPt2(v1.x, v1.y);
v2:= v0 + RotVec(EndPtV(h) - v0, rot);
SetSegPt2(v1.x, v1.y);

のように出来ます。
直線の端点をベクトルで指定して変更する手続き SetStartPtV と SetEndPtV を作れば

v0:= XY2Vec(x, y);
SetLinePtsV(h, v0 + RotVec(StartPtV(h) - v0, rot));
SetEndPtV(h, v0 + RotVec(GetEndPtV(h) - v0, rot));

のように3行まで縮められます。
そこまでやるなら、直線の両端を設定する手続き SetLinePtsV を作って

v0:= XY2Vec(x, y);
SetLinePtsV(h, v0 + RotVec(StartPtV(h) - v0, rot), v0 + RotVec(GetEndPtV(h) - v0, rot));

としても良いかも知れれません。
これなら結構簡潔だと思うかも知れませんが、VectorScriptでは

HRotate(h, x, y, rot);

のように図形を直接回転出来るので、わざわざ座標計算する必要はないのでした。
ただし、回転した座標(v1, v2)が必要なだけな場合(図形は回転させない)は、以下の

v0:= XY2Vec(x, y);
v1:= v0 + RotVec(StartPtV(h) - v0, rot);
v2:= v0 + RotVec(EndPtV(h) - v0, rot);

と、

GetLinePtsV(h, v01, v02);
HRotate(h, x, y, rot);
GetLinePtsV(h, v1, v2);
SetLinePtsV(h, v01, v02);

のどちらが良いかは一概に言えません。
不必要に図形を変形するのに抵抗があるなら前者のほうが良いですが、
そうでない場合は、回転前の座標を取得済みかどうかで話が違ってきます。

まあ、いずれにしても、
ここまでやって思ったのは、座標関係は全部ベクトル型変数で構わないのではないか、ということです。
座標が引数の関数や手続きでもベクトル型変数を使えたほうが楽です。
座標を返すのも、手続きより関数のほうが使いやすいですが、
関数の戻り値は1個だけと決まっているでXとYを別々には返せません。
だから当然関数の戻り値もベクトル型を使いたい、ということになります。

でも、既存バージョンでそうなる可能性はゼロだから(誰かがSDKサブルーチン・ライブラリを作らない限り)、
vssファイルを作って {$INCLUDE }で参照するしかないですね。


Re.:続・論理式の完全評価とショートカット評価    石男
Sat Aug 7 11:07:55 2010

与太郎さん、丁寧な解説をありがとうございました。
MiniCADプログラミング入門を引っぱり出したら、きちんと解説されていました。
ただ問題なのは「|」が「」てなっていて、どう入力していいのか...
そのうち、失念していたようです(笑)


続・論理式の完全評価とショートカット評価    与太郎
Thu Aug 5 11:40:41 2010

IF A AND B THEN の完全評価と言うのは、

boo:= A AND B;
IF boo THEN BEGIN
__真の場合の処理;
END
ELSE BEGIN
__偽の場合の処理;
END;

と同じことをやってます。

一方 IF A & B THEN のショートカット評価は

IF A THEN BEGIN
__IF B THEN BEGIN
____真の場合の処理;
__END
__ELSE BEGIN
____GOTO 1;
__END;
ELSE BEGIN
__GOTO 1;
END;
GOTO 2;
1: 偽の場合の処理;
2:

です。

IF A OR B THEN の完全評価は

boo:= A OR B;
IF boo THEN BEGIN
__真の場合の処理;
END
ELSE BEGIN
__偽の場合の処理;
END;

IF A | B THEN のショートカット評価は

IF A THEN BEGIN
__GOTO 1;
__IF B THEN BEGIN
____GOTO 1;
__END
__ELSE BEGIN
____GOTO 2;
__END;
ELSE BEGIN
__GOTO 2;
END;
GOTO 3;
1: 真の場合の処理;
GOTO 3;
2: 偽の場合の処理;
3:

なので、ショートカット評価のほうが完全評価より複雑な処理なのです。
複雑な処理を簡単に書けるのが、ショートカット評価の利点です。
完全評価では不可避なエラーを回避出来て、理論的には完全評価より処理が早い。
どちらを使うのがお得か?

判りますよね。

ショートカット評価の原理は以下の2つです。
論理積 A & B はAが偽ならBに関係なく偽なので、Aが偽の場合Bを評価しない。
論理和 A | B はAが真ならBに関係なく真なので、Aが真の場合Bを評価しない。


論理式の完全評価とショートカット評価    与太郎
Wed Aug 4 2:32:41 2010

ところで、下のスクリプトでは図形を選択していないと、
IF ( h <> NIL ) AND ( 25 = GetType( h ) ) THEN
で警告メッセージが出てしまいます。
ハンドル(h)がNILだとGetType( h )がエラーになるからです。
こういう場合はANDではなく&を使って、
IF ( h <> NIL ) & ( 25 = GetType( h ) ) THEN
とすれば、h=NILのときには( 25 = GetType( h ) )が実行されないのでエラーになりません。
つまり、( h <> NIL )がFALSE(つまりh=NIL)だと判った時点でそれ以上IF文の評価は必要ないので、
以降の( 25 = GetType( h ) )は実行されないわけです。
IF文(というか論理式)は式の左から評価してゆきますが、
途中で結果が確定したら残りの式を無視するのがショートカット評価、
結果にかかわりなく式を全て評価するのが完全評価です。
私の場合、「AND」や「OR」が必要な論理式は書かないので、「&」と「|」しか使いません。
つまり100%ショートカット評価です。

VectorScript Guideには完全評価やショートカット評価という語句は出てきません。
昔懐かしいTurbo Pascalマニュアルでの表現です。


Re2:3D多角形の周長    石男
Tue Aug 3 19:11:44 2010

与太郎 さん
修正していただきありがとうございました。
>Normって3Dベクトルの長さなんですよね。
はい、そうなんです。2Dだけだったり、3Dでもいけたりって書いてないから...
3Dベクトルの長さを返す関数作ってチェックしていたら、Normも使えてびっくりしたのを
思いだします。


Re:3D多角形の周長    与太郎
Tue Aug 3 17:39:34 2010

バグってたので直してみました。

PROCEDURE AddSidePoly3D ;
VAR
v1, v2 : VECTOR;
h : HANDLE;
i, End_i : INTEGER;
result : REAL;
BEGIN
h := FSActLayer;
IF ( h <> NIL ) AND ( 25 = GetType( h ) ) THEN BEGIN
End_i := GetVertNum( h ) - 1;
IF IsPolyClosed( h ) THEN
BEGIN
GetPolyPt3D( h, End_i, v1.x, v1.y, v1.z );
i := 0;
END ELSE BEGIN
GetPolyPt3D( h, 0, v1.x, v1.y, v1.z );
i := 1;
END;
REPEAT
GetPolyPt3D( h, i, v2.x, v2.y, v2.z );
result := result+Norm( v2 - v1 );
i := i + 1;
v1 := v2;
UNTIL i > End_i;
AlrtDialog( Concat( 'この3D多角形の周長は', result ) );
END ELSE BEGIN
AlrtDialog( '3D多角形を選択してください!' );
END;
END ;
RUN( AddSidePoly3D ) ;


Normって3Dベクトルの長さなんですよね。
2DのスクリプトでNormやVec2Angが変な結果を返してくるので何でかな?と思ったら、
バグでZ成分がゼロになってなかったというオチだった...
そういうこともありました。


3D多角形の周長    石男
Fri Jul 23 18:06:36 2010

あまり確認はしていませんが、3D多角形の周長を計算します。
PROCEDURE AddSidePoly3D ;
VAR
v1, v2 : VECTOR;
h : HANDLE;
i, End_i, c : INTEGER;
result : REAL;
BEGIN
h := FSActLayer;
IF ( h <> NIL ) AND ( 25 = GetType( h ) ) THEN
BEGIN
IF IsPolyClosed( h ) THEN
BEGIN
End_i := GetVertNum( h );
i := -1;
c := 0;
REPEAT
i := i+1;
c := c+1;
GetPolyPt3D( h, i, v1.x, v1.y, v1.z );
GetPolyPt3D( h, c, v2.x, v2.y, v2.z );
result := result+Norm( v2-v1 );
UNTIL i = End_i-1 ;
GetPolyPt3D( h, End_i-1, v1.x, v1.y, v1.z );
GetPolyPt3D( h, 0, v2.x, v2.y, v2.z );
result := result+Norm( v2-v1 );
AlrtDialog( Concat( 'この3D多角形の周長は', result ) );

END ELSE BEGIN
End_i := GetVertNum( h );
i := -1;
c := 0;
REPEAT
i := i+1;
c := c+1;
GetPolyPt3D( h, i, v1.x, v1.y, v1.z );
GetPolyPt3D( h, c, v2.x, v2.y, v2.z );
result := result+Norm( v2-v1 );
UNTIL i = End_i-1 ;
AlrtDialog( Concat( 'この3D多角形の周長は', result ) );
END;
END;
END ;

RUN( AddSidePoly3D ) ;


Re.:3次元計測ツール    江戸の黒板当番
Fri Jul 23 14:37:14 2010

いただきました。
3D多角形って距離(3次元での長さ)は表示されないんですよね。
ありがとうございます。


3次元計測ツール    石男
Fri Jul 23 11:09:17 2010

2010でようやくまともな3次元計測ツールができました。以前は3D基準点を使ったうさん臭い
ものは出来たのですが、2009ではそれも出来なくなりましたが...。
PROCEDURE Measur3D ;
VAR
v1, v2 : VECTOR;
FUNCTION TempToolCallback(action, msg1, msg2 : LONGINT) : LONGINT;
BEGIN
TempToolCallback := 0;
CASE action OF
3: BEGIN {kOnToolDoSetupEventID}
vstSetHelpString ( '計測したい2点目をクリックしてください' );

END;

103 : BEGIN {kToolDrawEventID}
vstGetCurrPt3D( v2.x, v2.y, v2.z, FALSE );
vstDrawCoordLine3D( v1.x, v1.y, v1.z, v2.x, v2.y, v2.z );

END;
END;
END;

BEGIN
SetTempToolHelpStr( '計測開始点をクリックしてください' );
GetPt3D( v1.x, v1.y, v1.z, FALSE );
RunTempTool( TempToolCallback, FALSE );
AlrtDialog( Concat( '距離= ', Num2Str( 3,Norm( v2-v1 ) ), ' x= ', Num2Str( 3, v2.x-v1.x ), ' y= ', Num2Str( 3, v2.y-v1.y ), ' z= ', Num2Str( 3, v2.z-v1.z ) ) );
END;

RUN( Measur3D ) ;


Re.:scriptですかワークシートですか    てっぺー
Fri Jun 4 10:00:52 2010

与太郎さま
江戸の黒板当番さま

ご親切な回答ありがとうございました。
出来なくはないかもしれないが、かなり技術が必要なんだということがわかりました。

また何か質問等あればよろしくお願い致します。


Re.:scriptですかワークシートですか    江戸の黒板当番
Thu Jun 3 10:03:25 2010

ワークシートの問題すっね。

ファイルリンク機能が出来た段階でワークシート名称がユニーク(唯一の存在)の
方でないとだめみたいですよ。

>ファイルA.ファイルB.に共通した名称のワークシートがあり、その中の同一のセルの内容を
ファイルCのワークシートにリンクさせることは可能でしょうか?
は共通名称があった段階でできない。

>ひとつのフォルダ内にある、すべてのファイルのワークシートの同一セルを他のファイルの
ワークシートにリンクさせることは可能でしょうか?
可能だけど大変そうだな。

ここん所はマニュアルも避けて通っているんじゃないだろうかと思われる程
未開の地ですよ。最近、ちょっとお化粧できるようになったのも
オーストラリアのパワーだもんね。
BIMだと標榜するんならもう少し使い易くして欲しい所ですな。

ところで一つのセルに1bite文字256字の制約解けないかなあ。


Re:scriptですかワークシートですか    与太郎
Thu Jun 3 8:19:09 2010

残念ですが、
VWではファイル間のワークシート参照は出来ません。
また、VectorScriptでファイルを指定することも出来ません。
なので、ご質問のようなことは無理だと思います。
ただしAppleScriptを使えば、フォルダー内のVWファイルを1つずつ開いて、
ワークシートのセルの内容を合計したり出来るはずです。
AppleScriptには、VectorScriptを埋め込む必要があるかも知れません。
WinでもAppleScriptに相当するものがあると思いますが、よく判りません。



scriptですかワークシートですか    てっぺー
Wed Jun 2 10:51:50 2010

はじめましてこんにちは。
script機能なのかワークシート機能なのかわからずこちらに投稿させて頂きます。

ワークシートを使っているのですが、下記の内容が可能かどうかご存じでしたら教えてください。

ファイルA.ファイルB.に共通した名称のワークシートがあり、その中の同一のセルの内容を
ファイルCのワークシートにリンクさせることは可能でしょうか?

もしくはひとつのフォルダ内にある、すべてのファイルのワークシートの同一セルを他のファイルのワークシートにリンクさせることは可能でしょうか?

どなたか教えてください。よろしくお願いします。


64ビット対応    与太郎
Thu May 27 10:11:38 2010

64ビット対応と言ってもメモリ空間が広くなるだけなので、スクリプトへの影響はないでしょう。

それよりも、PowerPCの時点ですでにCPU内部のレジスタは64ビットになってるのに、
いまだに整数型が16ビットのInteger型と32ビットのLongint型しかないのは困ります。
32ビットだと地球の全人口も扱えないし、金融関係も無理ですからね。
配列サイズの16ビット縛りもいい加減直して貰いたいです。
いまどきファイル内の図形が6万以上というのはざらにあるので、配列に入り切らない場面もあります。
配列を使わなくても図形の数を調べることは結構ありますが、Integer型(16ビット)だとオーバーフロー
する可能性が無視できません。

出来るだけLongint型(32ビット)を使うようにしていますが、
Integer型でもLongint型でも内部の処理は64ビットで構わないんじゃないかと思ったりします。


Re:誰も気にしない2040年問題    江戸の黒板当番
Tue May 25 11:01:32 2010

すみません。Scriptのことは全く分らないのですけども

>32ビット整数という制限も仕方がなかったと思われます。
に吸い寄せられてしまいました。
今は64ビットへOS段階で対応しつつあるようですが、
アプリベースではAr○○CADの窓7上で64ビットが動いている
ようですよね。
アプリ業界では生き残りをかけて書き直していると言うことなんでしょうか?

とするとVector Scriptも64ビット用なんてことになるんでしょうか?


誰も気にしない2040年問題    与太郎
Fri May 21 17:05:09 2010

VWのワークシートでもExcelのように日付や時間を使えます。
もちろん日数計算も出来ますが、2040年2月6日までしか扱えないという問題があります。
正確に言うと1904/1/1 0:00:00〜2040/2/6 6:28:15までしか扱えません。
40/2/7と打ち込むと一見ちゃんと表示されますが、それは2040/2/7じゃなくて1940/2/7です。
2040/2/7と打つと、1940/1/2か2040/2/6(最近のバージョン)になってしまいます。

VectorWorksでもExcelでも、日付データは内部では単なる数字です。
セルの書式を「標準」にしてみればそれは判ります。
たとえば、2010/5/21なら38857.5(Excelでは38857または38858)になるはずです。
これは、1904/1/1から2010/5/21までの日数です。
VWの場合は1904/1/1の0:00:00をゼロとして、そこからの日数がセルのデータとして記憶されます。
時刻は少数部の値(0〜1)が0:00:00〜24:00:00に対応します。
先の38857.5は2010/5/21の12:00:00PMということになります。
時刻(h:m:s)を0〜1の数値データにする式は、n = ((s/60 + m)/60 + h)/24 です。

VWのワークシートが2040/2/6までしか扱えない理由は、MiniCADが生まれた1988年当時のMacの仕様
と関係がありそうです。
当時のMacの内部時計は32ビットカウンタに秒単位の整数値を保持していました。
VWのほうでもそれに合わせておけば、システムルーチンで数値⇔日付時刻を変換できるし、
データも32ビット整数で間に合います。
そのころのMacで32ビット以上のデータを扱うのは煩雑で処理時間もかかりました。
そのために、MiniCADでは基本となる座標データも32ビット整数にしてしまいました。
建築用CADとしては、9桁の精度があれば必要十分ということもあったでしょう。
オプション扱いのFPU(もう若い人には通じないかも)を駆使してもMPUの整数演算にはかないません。
32ビット整数という制限も仕方がなかったと思われます。

さて、
32ビット整数では0〜4,294,967,295秒までを表せます。これは約49710日、136年ちょっとです。
Macの内部時計は1904/1/1からの秒数をカウントしていたので、VWでも当然それに合わせています。
そういうわけで、VWのワークシートで扱える日付の範囲は1904/1/1 0:00:00〜2040/2/6 6:28:15に
なってしまいました。
今でもそのままなのはどうかと思いますが、たぶん誰も使ってないので問題ないのでしょう。

32ビット整数と連呼してるのに、セルの値は実数じゃないかと言われるかも知れませんが、
そのへんのカラクリは判りません。
単純に86400で割って日単位の実数値にした方が扱いやすいんだと思います。(Excelもそうだし)
今でもシステムルーチンを使ってるわけもないだろうし。


Re.:ビットマップへの取り出し方法   NK
Thu May 13 20:54:46 2010

石男様

回答ありがとうございます。
SDKの情報をネットで検索していますが、英語の情報しかないようですね。
あまり時間もないのですが、取り合えずVC++で開発してみます。

今後もよろしくお願いします。


Re.:ビットマップへの取り出し方法    石男
Thu May 13 13:21:43 2010

テキストファイルを取り出すような細かい設定は出来ませんが、次のようなやり方は
出来ます。
 DoMenuTextByName('Export Image File',0 );
これで、イメージファイルの取り出しは出来ます。
>SDKを使っての開発になるのでしょうか?
はい、その通りです。資料はほぼ100%英語です。サポートもありませんので、素人の方に
はまずは無理かと思われます。


ビットマップへの取り出し方法   NK
Wed May 12 14:32:22 2010

初めまして。
最近VectorWorks2009でスクリプトを書き始めました。

環境:
WindowsXP+SP3
VectorWorks2009

作図した画像を、ビットマップファイルとして取り出すスクリプトを書きたいのですが、テキストファイル以外にはできないように思えますが、本当にできない のでしょうか?
またスクリプトで実現できない機能は、SDKを使っての開発になるのでしょうか?

どうぞお知恵を貸して下さい。


インクリメントとデクリメント    与太郎
Sat May 8 17:17:11 2010

(2日前の続き)

単にiの値を1つ増やすなら、CやJavaでは
   i++;
と書けますが、VectorScript(Pascal)で
   PostInc(i);
と書くとエラーになります。
VectorScriptでは関数の戻り値を無視することは出来ないので、
   変数:= PostInc(i);
のように書かないといけません。ダミー変数を使うくらいなら、素直に
   i:= i + 1;
と書いたほうがましでしょうか。
こういう場合はfunctionでなくprocedureにします。procedureには戻り値はありません。

procedure Inc(var i:integer);
begin
__i:= i + 1;
end;{Inc}

呼び出し側は、
   Inc(i);
となります。

結局、VectorScriptでインクリメントを使いたければ、

procedure Inc(var i:integer);
function PostInc(var i:integer):integer;
function PreInc(var i:integer):integer;

の3つのサブルーチンを使い分けることになります。
また、変数を参照する都合から、変数型が違えば別のサブルーチンが必要です。
インクリメントは整数以外には使わないので、integer型とlongint型があればいいでしょう。
名前の最後に変数型の頭文字を付けて区別することにします。
つまり、インクリメントには下の6つのサブルーチンが必要です。

procedure IncI(var i:integer);
procedure IncL(var i:longint);
function PostIncI(var i:integer):integer;
function PostIncL(var i:longint):longint;
function PreIncI(var i:integer):integer;
function PreIncL(var i:longint):longint;

i++ があれば当然 i-- や --i もあります。
こちらはデクリメントと呼びます。
同じように6つのサブルーチンが必要です。

procedure DecI(var i:integer);
procedure DecL(var i:longint);
function PostDecI(var i:integer):integer;
function PostDecL(var i:longint):longint;
function PreDecI(var i:integer):integer;
function PreDecL(var i:longint):longint;


ほとんどの人にはどうでもいいかも知れない細かい話    与太郎
Thu May 6 17:56:51 2010

プログラム(スクリプト)ではループ内でインデックス変数を+1して様々な処理を行うことが多いのですが、
VectorScript(Pascal)だと
j:= j + 1;
Message(j);
のように2つの文を書かないといけません。

CやJavaだと、
Message(++j);
のように1つの文で済みます。

Message(j);
j:= j + 1;
なら、
Message(j++);
と書きます。

++はインクリメント演算子で、++jをプリ・インクリメント、j++をポスト・インクリメントと呼びます。
Messageを呼ぶ前にjを+1するのがプリ・インクリメント、あとで+1するのがポスト・インクリメントです。
どちらの言語でも、機械語やアセンブラのレベルでは
Inc  j
Push  j
Call  Message
のようになるので実行速度やプログラムサイズには違いはありませんが、
元が教育用プログラミング言語だけあってPascalのほうが処理の順番は明確です。
後から出来たCやJavaでは簡潔な書き方が可能になっていますが、
メリットは命令が1行で済むとか、タイピング量が少ないことではなくて、
Pascalではjが3個もあるのに、CやJavaのような書き方だと1個で済むことです。
jを別の名前に変える場合、3箇所変えるより1箇所のほうが変え忘れなどのミスは少ないでしょう。

というわけで、Pascal(VectorScript)でも同じようなことが可能かどうかやってみましょう。
例として、下の簡単なスクリプトを改造してみます。

procedure test1;
{$DEBUG}
var
__i, j, k__:integer;
begin
__j:= 0; k:= 0;
__for i:= 1 to 5 do begin
____j:= j + 1;
____Message(j, ', ', k);
____k:= k + 1;
__end;
end;
Run(test1);

ループ内の
j:= j + 1;
Message(j, ', ', k);
k:= k + 1;
の3行を Message(++j, ', ', k++); のようにしたいのですが、Pascalにはインクリメント演算子はありません。
仕方がないので関数でやってみます。

procedure test2;
{$DEBUG}
var
__i, j, k__:integer;
function PreInc(var i:integer):integer;
begin
__i:= i + 1;
__PreInc:= i;
end;{PreInc}

function PostInc(var i:integer):integer;
begin
__PostInc:= i;
__i:= i + 1;
end;{PostInc}

begin{main}
__j:= 0; k:= 0;
__for i:= 1 to 5 do begin
____Message(PreInc(j), ', ', PostInc(k));
__end;
end;{main}
Run(test2);

元よりかなり長くなりましたが、ループ内は1行に収めることが出来ました。


Re:プラグインツールのパラメーター    与太郎
Thu Apr 1 12:57:36 2010

GetObject('プラグインツールの名前')で返ってくるハンドルは、レコードを指しています。
この図形に属さないレコードがプラグインツールのデフォルトパラメータです。
もちろんSetRFieldで値を書き換えることも出来ます。


プラグインツールのパラメーター    村のポンコツ屋
Thu Apr 1 12:00:16 2010

プラグインメニューやツールで計算作業を行うとき、初期設定値をファイルに残したいのです。
プラグインオブジェクトでは、オブジェクト自身のハンドルとパラメーターを使用して
SerRfieldでパラメーターの値を書き換えることは可能なのですが、
ツールやメニューは自身のハンドルを持たないので、パラメーターの内容を変更することができません。
何かよい方法は有りませんか?


Re2:タブコントロール    石男
Thu Mar 11 17:54:27 2010

>>Tabを特定することが出来ません。
>とは、表示するタブをスクリプトで変更するということでせうか?
はい、例えばTab1のアイテムによってTab3の表示するアイテムを変えられるのかと...
結局のところ、SwapControlを併せて使わないと出来ないということが分かりました。
もっとも、他に方法があるかもしれませんが...。


Re:タブコントロール    与太郎
Thu Mar 11 16:49:01 2010

私自身はダイアログはめったに作らないので、タブコントロールもはじめて触ったのですが、
タブは意識せずにアイテムのみに注目すればいいような感じです。
あるアイテムでイベントが発生したら、そのアイテムの属するタブが表示されてるはずなので、
あえてタブを特定する必要はないと思いますが...

>Tabを特定することが出来ません。
とは、表示するタブをスクリプトで変更するということでせうか?


タブコントロール    石男
Wed Mar 10 14:44:55 2010

モダンダイアログにタブを付けられるようになって久しいですが、今回初めて挑戦してお
ります。そこで、Tab1、Tab2、Tab3と作ってTab毎の命令を書いていきたいのですが、
Tabを特定することが出来ません。どのようにしたら、良いのか分かる方がいましたら
お教えください。


バックナンバーへ送りましたが    管理人
Mon Dec 28 18:09:24 2009

続きを書いてくださっても、もちろん構いません。
もし、談話室の不具合などありましたら、管理人までご一報下さい。