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

Re2:RGB値で色作り    石男
Fri Dec 25 20:48:15 2009

>なぜかRGB値やCMYK値で色作りができない...。
ごめんなさい、誤りでした。属性パレット--カラーピッカー--カラーつまみで数値指定
出来ます。何かの足しに使ってください。


RGB値で色作り    石男
Fri Dec 25 11:19:59 2009

VW2008以降、256色から無制限?に色を扱えるようになったのに、なぜかRGB値やCMYK値で
色作りができない...。そんな訳でイラレのカラーピッカーのようなものが出来ないか、
作ってみました。カラーポップアップとRGB値の数値指定で色が作れます。ボタンをクリックすればRGB値やCMYK値が分かります。

面図形を選択して実行してください、エラー処理はしていないので爆発する恐れがありま
す(笑)2008以降で制限をかけていますが、はずせばそれ以前でも動くはずですが意味が
ありません。
{ VW 2008~ }
PROCEDURE SetColorBack;
VAR
g_color, g8_color : RGBCOLOR;
CMYK_array : ARRAY[ 1..4 ] OF REAL;
BooCMYK : BOOLEAN;
h : HANDLE;
x, x2, y, y2 : REAL;
{ VW Versin }
FUNCTION GetVWVersion: INTEGER;
VAR
valueInt, appMajor, platform : INTEGER;
BEGIN
GetVersion( appMajor, valueInt, valueInt, platform );
GetVWVersion := appMajor;
END;
{ Converts RGB to CMYK, rgb values must be 16-bit (range 0-65535) }
PROCEDURE C_RGBtoCMYK( mycolor : RGBCOLOR; VAR c, m, y, k : REAL );
VAR
maxRGB, minRGB : REAL;
temp_l : LONGINT;
BEGIN
c := 1-( mycolor.red );
m := 1-( mycolor.green );
y := 1 -( mycolor.blue );

k := Min( c, m );
k := Min( k, y );

c := ( c-k )/65535;
m := ( m-k )/65535;
y := ( y-k )/65535;

IF k = -65534 THEN k := 0 ELSE k := 1 + k/65535;
END;
{ InvalidValue }
PROCEDURE InvalidValue(controlID :INTEGER; var item :LONGINT; msg :STRING);
BEGIN
item := -1;
SelField(controlID);
SysBeep;
IF msg <> '' THEN AlrtDialog(msg);
END;
{ converts a color part (red or green or blue) from 16-bits to 8-bits }
{ range 0-65535 to range 0-255 }
FUNCTION U_c255(color: LONGINT): INTEGER;
BEGIN
U_c255 := color/257;
END;

{ converts a color part (red or green or blue) from 8 to 16 bits }
{ from range 0-255 to range 0-65535 }
FUNCTION C_65535(color: INTEGER): LONGINT;
BEGIN
C_65535 := color * 257;
IF C_65535 > 65535 THEN
C_65535 := 65535;
END;

FUNCTION RunEditDialog( VAR myColor, my8Color : RGBCOLOR; VAR IsCMYK : BOOLEAN ): BOOLEAN;
VAR
dialog : INTEGER;
co_index, colorIndex : INTEGER;
bool : BOOLEAN;
PROCEDURE dialog_Handler( VAR item : LONGINT; data : LONGINT );
BEGIN
CASE item OF
SetupDialogC: BEGIN
SetItem( 4, TRUE );
SetColorButton( dialog, 29, 65535, 65535, 65535 );{System Color}
RGBToColorIndex( 65535, 65535, 65535, colorIndex );
SetColorChoice( dialog, 5, colorIndex );{ColorPopup}
END;
4:
BEGIN
IF ItemSel( 4 ) THEN BEGIN
SetItemEnable( 5, TRUE );
SetItemEnable( 6, TRUE );
SetItemEnable( 7, TRUE );
SetItemEnable( 8, TRUE );
SetItemEnable( 9, TRUE );
SetItemEnable( 10, TRUE );
SetItemEnable( 11, TRUE );
SetItemEnable( 12, TRUE );
END ELSE BEGIN
SetItemEnable( 5, FALSE );
SetItemEnable( 6, FALSE );
SetItemEnable( 7, FALSE );
SetItemEnable( 8, FALSE );
SetItemEnable( 9, FALSE );
SetItemEnable( 10, FALSE );
SetItemEnable( 11, FALSE );
SetItemEnable( 12, FALSE );
END;
END;
6:
BEGIN
GetColorChoice( dialog, 5, co_index );
ColorIndexToRGB( co_index, myColor.red, myColor.green, myColor.blue );
SetField( 8, Num2Str( 0, U_c255(myColor.red) ) );
SetField( 10, Num2Str( 0, U_c255(myColor.green) ) );
SetField( 12, Num2Str( 0, U_c255(myColor.Blue) ) );
END;
13:
BEGIN
IF ItemSel( 13 ) THEN BEGIN
SetItemEnable( 14, TRUE );
SetItemEnable( 15, TRUE );
SetItemEnable( 16, TRUE );
SetItemEnable( 17, TRUE );
SetItemEnable( 18, TRUE );
SetItemEnable( 19, TRUE );
SetItemEnable( 20, TRUE );
SetItemEnable( 21, TRUE );
SetItemEnable( 22, TRUE );
SetItemEnable( 23, TRUE );
SetItemEnable( 24, TRUE );
SetItemEnable( 25, TRUE );
SetItemEnable( 26, TRUE );
SetItemEnable( 27, TRUE );
SetItemEnable( 28, TRUE );
SetItemEnable( 29, FALSE );
ShowItem( dialog, 29, TRUE);
END ELSE BEGIN
SetItemEnable( 14, FALSE );
SetItemEnable( 15, FALSE );
SetItemEnable( 16, FALSE );
SetItemEnable( 17, FALSE );
SetItemEnable( 18, FALSE );
SetItemEnable( 19, FALSE );
SetItemEnable( 20, FALSE );
SetItemEnable( 21, FALSE );
SetItemEnable( 22, FALSE );
SetItemEnable( 23, FALSE );
SetItemEnable( 24, FALSE );
SetItemEnable( 25, FALSE );
SetItemEnable( 26, FALSE );
SetItemEnable( 27, FALSE );
SetItemEnable( 28, FALSE );
SetItemEnable( 29, FALSE );
ShowItem( dialog, 29, TRUE);
END;
END;
20:
BEGIN
IF NOT GetEditInteger( dialog, 15, my8Color.red ) THEN InvalidValue( 15, item, '' );
IF NOT GetEditInteger( dialog, 17, my8Color.green ) THEN InvalidValue( 17, item, '' );
IF NOT GetEditInteger( dialog, 19, my8Color.blue ) THEN InvalidValue( 19, item, '' );
myColor.red := C_65535( my8Color.red );
myColor.green := C_65535( my8Color.green );
myColor.blue := C_65535( my8Color.blue );
C_RGBtoCMYK( mycolor, CMYK_array[1], CMYK_array[2], CMYK_array[3], CMYK_array[4] );
SetField( 22, Num2Str( 3, CMYK_array[1] ) );
SetField( 24, Num2Str( 3, CMYK_array[2] ) );
SetField( 26, Num2Str( 3, CMYK_array[3] ) );
SetField( 28, Num2Str( 3, CMYK_array[4] ) );
SetColorButton( dialog, 29, myColor.red, myColor.green, myColor.blue );
END;

{OK}
1:
BEGIN
IF ItemSel( 4 ) THEN BEGIN
GetColorChoice( dialog, 5, co_index );
ColorIndexToRGB( co_index, myColor.red, myColor.green, myColor.blue );
my8Color.red := U_c255(myColor.red);
my8Color.green := U_c255(myColor.green);
my8Color.blue := U_c255(myColor.blue);
IsCMYK := FALSE;
END;
IF ItemSel( 13 ) THEN BEGIN
IF NOT GetEditInteger( dialog, 15, my8Color.red ) THEN InvalidValue( 15, item, '' );
IF NOT GetEditInteger( dialog, 17, my8Color.green ) THEN InvalidValue( 17, item, '' );
IF NOT GetEditInteger( dialog, 19, my8Color.blue ) THEN InvalidValue( 19, item, '' );
myColor.red := C_65535( my8Color.red );
myColor.green := C_65535( my8Color.green );
myColor.blue := C_65535( my8Color.blue );
C_RGBtoCMYK( mycolor, CMYK_array[1], CMYK_array[2], CMYK_array[3], CMYK_array[4] );
IsCMYK := TRUE;
END;
END ;

END ;{Case}
END ;
{///////////////////////// RunEditColDialog Main ////////////////////////////}
BEGIN
RunEditDialog := FALSE ;
dialog := CreateLayout( 'RGB Color', TRUE, 'OK', 'Cancel' );

CreateRadioButtonGroupBox (dialog, 4, 'ColorPopup', TRUE );
CreateColorPopup (dialog, 5, 24 );
CreatePushButton (dialog, 6, '8bits-RGB' );
CreateStaticText (dialog, 7, 'Red:', 10);
CreateStaticText (dialog, 8, '', 10);
CreateStaticText (dialog, 9, 'Green:', 10);
CreateStaticText (dialog, 10,'', 10);
CreateStaticText (dialog, 11,'Blue:', 10);
CreateStaticText (dialog, 12,'', 10);

CreateRadioButtonGroupBox (dialog, 13, '8bits-RGB', TRUE );
CreateStaticText (dialog, 14, 'Red:', 10);
CreateEditInteger (dialog, 15, 255, 16);
CreateStaticText (dialog, 16, 'Green:', 10);
CreateEditInteger (dialog, 17, 255, 16);
CreateStaticText (dialog, 18, 'Blue:', 10);
CreateEditInteger (dialog, 19, 255, 16);
CreatePushButton (dialog, 20, 'CMYK' );
CreateStaticText (dialog, 21, 'C:', 10);
CreateStaticText (dialog, 22, '', 10);
CreateStaticText (dialog, 23, 'M:', 10);
CreateStaticText (dialog, 24, '', 10);
CreateStaticText (dialog, 25, 'Y:', 10);
CreateStaticText (dialog, 26, '', 10);
CreateStaticText (dialog, 27, 'K:', 10);
CreateStaticText (dialog, 28, '', 10);
CreateControl (dialog, 29, 2, '', 360149525 );

SetFirstLayoutItem(dialog, 4 );
SetFirstGroupItem (dialog, 4, 5 );
SetBelowItem (dialog, 5, 6, 0, 0 );
SetBelowItem (dialog, 6, 7, 0, 0 );
SetRightItem (dialog, 7, 8, 0, 0);
SetBelowItem (dialog, 7, 9, 0, 0 );
SetRightItem (dialog, 9, 10, 0, 0 );
SetBelowItem (dialog, 9, 11, 0, 0 );
SetRightItem (dialog, 11, 12, 0, 0 );
SetRightItem (dialog, 4, 13, 0, 0 );
SetFirstGroupItem (dialog, 13, 14 );
SetRightItem (dialog, 14, 15, 0, 0 );
SetBelowItem (dialog, 14, 16, 0, 0 );
SetRightItem (dialog, 16, 17, 0, 0 );
SetBelowItem (dialog, 16, 18, 0, 0 );
SetRightItem (dialog, 18, 19, 0, 0 );
SetBelowItem (dialog, 18, 20, 0, 0 );
SetBelowItem (dialog, 20, 21, 0, 0 );
SetRightItem (dialog, 21, 22, 0, 0 );
SetRightItem (dialog, 20, 29, 0, 0 );
SetBelowItem (dialog, 21, 23, 0, 0 );
SetRightItem (dialog, 23, 24, 0, 0 );
SetBelowItem (dialog, 23, 25, 0, 0 );
SetRightItem (dialog, 25, 26, 0, 0 );
SetBelowItem (dialog, 25, 27, 0, 0 );
SetRightItem (dialog, 27, 28, 0, 0 );

{run test dialog}
IF RunLayoutDialog( dialog, dialog_Handler ) = 1 Then BEGIN
RunEditDialog := TRUE;
END ;
END ;
{////////////////////////////// Main ////////////////////////////}
BEGIN
IF GetVWVersion >= 13 THEN BEGIN
h := FSActLayer;
IF h <> NIL THEN BEGIN
IF RunEditDialog( g_color, g8_color, BooCMYK ) THEN BEGIN
IF BooCMYK = TRUE THEN BEGIN
SetFillBack( h, g_color.red, g_color.green, g_color.blue );
GetBBox( h, x, y, x2, y2 );
MoveTo( ( x+x2 )/2, ( y+y2 )/2 );
CreateText( Concat( 'Red =', g8_color.red, ' Green =', g8_color.green, ' Blue =', g8_color.blue, Chr( 13 ), ' C =', Num2Str( 3, CMYK_array[1] ), ' M =', Num2Str( 3, CMYK_array[2] ), ' Y =', Num2Str( 3, CMYK_array[3] ), ' K =', Num2Str( 3, CMYK_array[4] ) ) );
ReDrawAll;
END ELSE BEGIN
SetFillBack( h, g_color.red, g_color.green, g_color.blue );
GetBBox( h, x, y, x2, y2 );
MoveTo( ( x+x2 )/2, ( y+y2 )/2 );
CreateText( Concat( 'Red =', g8_color.red, ' Green =', g8_color.green, ' Blue =', g8_color.blue ) );
ReDrawAll;
END;
END;
END;{h}
END ELSE AlrtDialog( 'VectorWorks 2008以前は使えません' );
END;
RUN( SetColorBack );


Re6:QuickTimeMovie   ゴンスケ
Thu Dec 24 11:06:13 2009

黒板当番さん、石男さん、なるほど!
操作に手間と時間がかかることはやらない方針なので、ありがたいです。
早く地下から出て日の光を浴びられんことを!!
喫茶室ネタで失礼。


Re5:QuickTimeMovie   石男
Wed Dec 23 15:11:13 2009

>ゴンスケさん
江戸の黒板当番さんのご依頼で5年ぐらい前から続いている地下プロジェクトの産物です。
もともとは、kanabunさんのMovieMakerをベースにさせてもらってアレンジしています。
ゴンスケさんと同様に私もアニメーションの設定が面倒で使っていませんでした。
多分、ほとんどの方がそうではないかと思いますが...
簡単な設定でアニメーションを作るというコンセプトなので複雑なことはできませんが。

はい、そう言う訳で江戸の黒板当番さんの方にお願いします(笑)


Re4:QuickTimeMovie   江戸の黒板当番
Wed Dec 23 11:28:16 2009

ゴンスケさん 横レスごめんなさい。

これは昔の生姜のプロジェクトを再開した一部なんですよ。
現在、β版というか昔からずうっとβなんですが,,,,

3次元モデルの中を歩ける環境での活用が期待できるんじゃない?と
復活させようよと始めたやつなんです。

早く小さく確認したり、大きくじっくりプレゼ用を作ったりの
バリエーションって大事でないかと思うんですよ。
β版って2009用ですけど必要であればお送りしますよ。


Re3:QuickTimeMovie   ゴンスケ
Wed Dec 23 10:43:51 2009

石男さん、いつも素晴らしいスクリプトをありがとうございます。
1年ほどかけて、うちの墓をVectorWorksとPhotoshopでデザインしましたが、
CGと同じものができあがって、良かったというか、感動がなかったというか...。
それはさておき、今回のプラグインですが、石男さんがどのようなシーンで
活用されるのかということに興味があるので、もし差し支えなければ教えてください。
私自身は、アニメーションの設定とか計算時間など、昔のたいへんだった頃の苦労が
トラウマになっていて、いまはアニメーションを作ることがほとんどありません....。


Re2:QuickTimeMovie   石男
Thu Dec 17 20:17:11 2009

QuickTimeの設定はモダンダイアログで設定させるのが、本当なのでしょうが...
カメラパスも直線ではなく、多角形、3D多角形、Nurbsなどを使えば良いかと。
Projectionの後にSetZoomで100%にしないと実際のムービーサイズもその倍率を
引きずるようです。

とにかく反応があって良かったです(笑)


Re:QuickTimeMovie   与太郎
Thu Dec 17 18:21:47 2009

石男さん、ありがとうございます。参考にさせていただきます。

お試しでやるには時間がかかり過ぎるので、画面サイズやフレームレートを下げて、
2km/hだと遅く感じたので20km/hにしてみました。
また、何も表示しないと止まったんじゃないかと不安になるので、メッセージも追加しました。

PROCEDURE Example10a ;
VAR
gStart , gEnd , p_pt : VECTOR ;
cam_z , mmpfl , jisoku , frameRate , gAng , long_path : REAL ;
gRender, koma , i , QT_Ok, QT_Num : INTEGER ;
QTFname : STRING ;
cameraPt: DYNARRAY[ ] OF VECTOR ;
gZoom, t0, t : LONGINT;
hPath : HANDLE;

{//////////////////////////////Set_Projection/////////////////////////////}
PROCEDURE Set_Projection( Lenz_Dist , w_pix, h_pix : REAL ; myprojec , rendering : INTEGER ) ;
VAR
Real_Offset, w_dis, h_dis : REAL;
left_p, right_p : VECTOR ;
BEGIN
w_dis := ( w_pix*25.4*GetLScale( ActLayer ) )/72 ;
h_dis := ( h_pix*25.4*GetLScale( ActLayer ) )/72 ;
left_p.x := -w_dis/2 ; left_p.y := h_dis/2 ;
right_p.x := w_dis/2 ; right_p.y := -h_dis/2 ;
Real_Offset := ( 25.413 * GetLScale( ActLayer ) ) * Lenz_Dist ;
Projection( myprojec , rendering , Real_Offset , left_p.x, left_p.y, right_p.x, right_p.y );
{ myprojec= Perspective透視投影 =1 Orthogonal等角投影 = 0 }
Locus( left_p.x, left_p.y );
Locus( right_p.x, right_p.y );
SetZoom( 100 );
END ;
{////////////////////////////// Main ////////////////////////////}
BEGIN
hPath:= FSActLayer;
IF (hPath = NIL) | (GetType(hPath) <> 2) THEN
AlrtDialog('直線を選択して下さい。')
ELSE BEGIN
gZoom := GetZoom;
gRender := 11 ;{ 2~5 = VWソリッド,シェイドはダメ }
cam_z := 1500 ;
jisoku := 20 * 1000000 ; {20km/hを変換}
frameRate := 15 ;{標準:29.97}
QTFname := 'TestQTMovie.mov' ;
mmpfl := ( jisoku / 3600 ) / frameRate ;{mmpfl 1フレイムでの移動距離}
GetSegPt1( hPath, gStart.x , gStart.y ) ;
GetSegPt2( hPath, gEnd.x , gEnd.y ) ;
ReDrawAll;
long_path := Norm( gEnd - gStart ) ;
gAng := Vec2Ang( gEnd - gStart ) ;
koma := Trunc( long_path/mmpfl ) ;
ALLOCATE cameraPt[ 1..koma+1 ] ;
i := 0 ;
REPEAT
i := i + 1 ;
IF i = 1 THEN BEGIN
cameraPt[ i ].x := gStart.x ;
cameraPt[ i ].y := gStart.y ;
cameraPt[ i ].z := cam_z ;
END ELSE BEGIN
p_pt := Ang2Vec( gAng , mmpfl*( i - 1 ) ) ;
p_pt := p_pt + gStart ;
cameraPt[ i ].x := p_pt.x ;
cameraPt[ i ].y := p_pt.y ;
cameraPt[ i ].z := cam_z ;
END ;
UNTIL i = koma+1 ;
Set_Projection( 8.5 , 960, 480, 1 , gRender ) ;{320*240 - 640*480 - 720*480 - 960*720まで}
SetViewVector( cameraPt[ 1 ].x , cameraPt[ 1 ].y , cameraPt[ 1 ].z , cameraPt[ 2 ].x , cameraPt[ 2 ].y , cameraPt[ 2 ].z , 0, 0 , 1 ) ;
SetLayerRenderMode( ActLayer , gRender , TRUE , TRUE ) ;
ReDrawAll ;
QT_Ok := QTInitialize;
IF QT_Ok <> 0 THEN BEGIN
QT_Num := QTOpenMovieFile( QTFname ) ;
IF QT_Num <> -1 THEN BEGIN
QTSetMovieOptions( QT_Num,frameRate , 24, TRUE , TRUE );
t0:= GetTickCount;
IF NOT DidCancel THEN BEGIN
DelObject( hPath ) ;
FOR i := 1 TO koma DO
BEGIN
SetViewVector( cameraPt[ i ].x , cameraPt[ i ].y, cameraPt[ i ].z , cameraPt[ i +1 ].x, cameraPt[ i +1 ].y, cameraPt[ i +1 ].z , 0 , 0 , 1 ) ;
ReDrawAll ;
t:= GetTickCount;
Message('書き出し中:',i, '/', koma, '(', Round((t-t0)/60), '秒経過、残り', Round((t-t0)/60*(koma-i)/i),'秒)');
QTWriteFrame( QT_Num ) ;
END ;

QTCloseMovieFile(QT_Num) ;
MoveTo( gStart.x , gStart.y ) ;
LineTo( gEnd.x , gEnd.y ) ;
END ;
END ;
END ;
SetZoom( gZoom );
ClrMessage;
SysBeep;
AlrtDialog('QTムービーの書き出しが終わりました。');
END;
END ;

RUN( Example10a ) ;


QuickTimeMovie   石男
Wed Dec 16 10:31:54 2009

簡単なQuickTimeネタを...。
適当な長さの線分を選択して実行するとそこをカメラがある一定のスピードで移動する
QuickTimeMovieを作れます。エラー処理などは考慮していないのでよく見てから、
使用してください。QTSetMovieOptionsでQuickTimeの設定ダイアログが出ますが、この
ダイアログでキャンセルすると強制終了するはめに陥ります。この設定ダイアログを表示
させないオプションもありますが、ver.11の頃から2009までバグにて効きません。
私の知る限り、QuickTimeのサンプルは存在しないのでご自由にお使いください。
PROCEDURE Example10 ;
VAR
gStart , gEnd , p_pt : VECTOR ;
cam_z , mmpfl , jisoku , frameRate , gAng , long_path : REAL ;
gRender, koma , i , QT_Ok, QT_Num : INTEGER ;
QTFname : STRING ;
cameraPt: DYNARRAY[ ] OF VECTOR ;
gZoom : LONGINT;

{//////////////////////////////Set_Projection/////////////////////////////}
PROCEDURE Set_Projection( Lenz_Dist , w_pix, h_pix : REAL ; myprojec , rendering : INTEGER ) ;
VAR
Real_Offset, w_dis, h_dis : REAL;
left_p, right_p : VECTOR ;
BEGIN
w_dis := ( w_pix*25.4*GetLScale( ActLayer ) )/72 ;
h_dis := ( h_pix*25.4*GetLScale( ActLayer ) )/72 ;
left_p.x := -w_dis/2 ; left_p.y := h_dis/2 ;
right_p.x := w_dis/2 ; right_p.y := -h_dis/2 ;
Real_Offset := ( 25.413 * GetLScale( ActLayer ) ) * Lenz_Dist ;
Projection( myprojec , rendering , Real_Offset , left_p.x, left_p.y, right_p.x, right_p.y ); { myprojec= Perspective透視投影 =1 Orthogonal等角投影 = 0 }
Locus( left_p.x, left_p.y );
Locus( right_p.x, right_p.y );
SetZoom( 100 );
END ;
{////////////////////////////// Main ////////////////////////////}
BEGIN
gZoom := GetZoom;
gRender := 11 ;{ 2~5 = VWソリッド,シェイドはダメ }
cam_z := 900 ;
jisoku := 2*1000000 ; {2km/hを変換}
frameRate := 29.97 ;
QTFname := 'TestQTMovie.mov' ;
mmpfl := ( jisoku/3600 )/frameRate ;{mmpfl 1フレイムでの移動距離}
GetSegPt1( FSActLayer, gStart.x , gStart.y ) ;
GetSegPt2( FSActLayer, gEnd.x , gEnd.y ) ;
DelObject( FSActLayer );
ReDrawAll;
long_path := Norm( gEnd-gStart ) ;
gAng := Vec2Ang( gEnd-gStart ) ;
koma := Trunc( long_path/mmpfl ) ;
ALLOCATE cameraPt[ 1..koma+1 ] ;
i := 0 ;
REPEAT
i := i+1 ;
IF i = 1 THEN BEGIN
cameraPt[ i ].x := gStart.x ;
cameraPt[ i ].y := gStart.y ;
cameraPt[ i ].z := cam_z ;
END ELSE BEGIN
p_pt := Ang2Vec( gAng , mmpfl*( i-1 ) ) ;
p_pt := p_pt+gStart ;
cameraPt[ i ].x := p_pt.x ;
cameraPt[ i ].y := p_pt.y ;
cameraPt[ i ].z := cam_z ;
END ;
UNTIL i = koma+1 ;
Set_Projection( 8.5 , 960, 720, 1 , gRender ) ;{320*240-640*480-720*480-960*720まで}
SetViewVector( cameraPt[ 1 ].x , cameraPt[ 1 ].y , cameraPt[ 1 ].z , cameraPt[ 2 ].x , cameraPt[ 2 ].y , cameraPt[ 2 ].z , 0, 0 , 1 ) ;
SetLayerRenderMode( ActLayer , gRender , TRUE , TRUE ) ;
ReDrawAll ;
QT_Ok := QTInitialize;
IF QT_Ok <> 0 THEN BEGIN
QT_Num := QTOpenMovieFile( QTFname ) ;
IF QT_Num <> -1 THEN BEGIN
QTSetMovieOptions( QT_Num,frameRate , 24, TRUE , TRUE );
IF NOT DidCancel THEN BEGIN
FOR i := 1 TO koma DO
BEGIN
SetViewVector( cameraPt[ i ].x , cameraPt[ i ].y, cameraPt[ i ].z , cameraPt[ i +1 ].x, cameraPt[ i +1 ].y, cameraPt[ i +1 ].z , 0 , 0 , 1 ) ;
ReDrawAll ;
QTWriteFrame( QT_Num ) ;
END ;

QTCloseMovieFile(QT_Num) ;
MoveTo( gStart.x , gStart.y ) ;
LineTo( gEnd.x , gEnd.y ) ;
END ELSE BEGIN
MoveTo( gStart.x , gStart.y ) ;
LineTo( gEnd.x , gEnd.y ) ;
END ;
END ;
END ;
SetZoom( gZoom );
END ;

RUN( Example10 ) ;


Re8:ループからの脱出    与太郎
Fri Dec 11 12:52:33 2009

>ネタはQuickTimeMovieを書き出すためのモダンダイアログを作っていたのですが...

もしかして、
>>与太郎さん
> 下の手はかなり良いものだと思いますよ。
これで刺激されちゃいましたか?
プラグインのメンテナンスしてる間に先を越された(笑)。


Re7:ループからの脱出    石男
Fri Dec 11 9:20:52 2009

ネタはQuickTimeMovieを書き出すためのモダンダイアログを作っていたのですが...
 1.Movie全体を書き出す 2.Movieの一部を書き出す 3.プレビュー
1,2のケースはダイアログを閉じて処理、3をダイアログを出したままでの処理にしようと
思いあれやこれや試していた訳です。
 で、結局、3の処理をダイアログを一旦閉じてプレビューを行い、またダイアログを呼び出すといった流れにしました。プレビューの途中でやめたい時は KeyDownでループを抜
けるというようにとここで、一連のアドバイスを参考にしました。
 もっとも、ダイアログ表示--1〜3の処理をREPEAT文でループにさせていますし、Movie
プレビューと言った画像を作るときもループ処理ですからかなりアドバイスは参考になり
ましたよ(笑)


Re6:ループからの脱出    与太郎
Fri Dec 11 8:23:13 2009

>プッシュボタン(スタート)を押す---このプッシュボタンの表示文字をストップに変更
>し、ループの命令を実行、終了条件にループの回数とMouseDownを使ってクリックすれば
>終了!にしました

イベント・ループで回さずに、普通のループということですね。
やっと判りました(笑)。


Re5:ループからの脱出    石男
Wed Dec 9 12:02:40 2009

>与太郎さん
度々のアドバイス、ホントにありがとうございました。なぜか2004のバックナンバーだけ
見落としていました。ここに重大なヒントがありました。

プッシュボタン(スタート)を押す---このプッシュボタンの表示文字をストップに変更
し、ループの命令を実行、終了条件にループの回数とMouseDownを使ってクリックすれば
終了!にしました。

 MouseDownもGetPtも命令の途中に割り込んで、しかも命令そのものを妨げないんですね
表示をストップにしておけば、そこをクリックするでしょうし問題なさそうなので...
 これで大幅な書き換えをしないで済みそうです。


Re4:ループからの脱出    与太郎
Wed Dec 9 10:43:08 2009

どうしてもと言うのなら、グループ図形などで自前のダイアログを作る方法があります。
「2004年・Script談話室バックナンバー」の「スクリプトの中でカラーパレットを使う」や
「スクリプトの中で線種選択メニューを使う」が参考になるかと思います。


Re3:ループからの脱出    石男
Wed Dec 9 10:04:58 2009

>与太郎さん
いつもお答えいただきすいません。
>ダイアログ表示中はMessageが使えませんね
知りませんでした、今まで(笑)

アドバイスと過去のログを踏まえて、モダンダイアログの表示中にスクリプトを走らせる
ようにしました。プッシュボタン(スタート)を押すと見事にループは回りましたが、
もう一つのプッシュボタン(ストップ)を押してもループは止まらず脱出失敗でした。
もちろん、ループの終了条件にループの回数と共にストップボタンを押したら終わりの
も付けています。というより、スタートボタンで始まる命令が終わるまで、他のボタンを
押すと言った命令が効かないようです。
他のプラグインでこういったことをやっていたので、VSでも可能なのかと考えたのですが
あれはSDKなのかな?一応、痕跡を...
PROCEDURE DlogTest;

FUNCTION RunEditDialog : BOOLEAN;
VAR
dialog, i : INTEGER;
flag : BOOLEAN;
PROCEDURE dialog_Handler( VAR item : LONGINT; data : LONGINT );
BEGIN
CASE item OF
SetupDialogC: BEGIN
END;
4: BEGIN
flag := FALSE;
i := 0;
REPEAT
i := i+1;
Rect( i, 1, i+1, -1 );
ReDrawAll;
Wait( 1 );
UNTIL ( i = 10 ) OR ( item = 5 );
END;
{Fin}
1: BEGIN

END;

END;{Case}
END;
{///////////////////////// RunEditColDialog Main ////////////////////////////}
BEGIN
RunEditDialog := FALSE ;
dialog := CreateLayout( '' , TRUE , 'Fin' , '' ) ;

{create controls}
CreatePushButton( dialog, 4, 'Start!' );
CreatePushButton( dialog, 5, 'Stop!' );


SetFirstLayoutItem( dialog, 4 ) ;
SetBelowItem( dialog, 4, 5, 0, 0 ) ;

{run test dialog}
IF RunLayoutDialog( dialog, dialog_Handler ) = 1 Then BEGIN
RunEditDialog := TRUE ;
END ;
END ;
{////////////////////////////// DlogTest Main ////////////////////////////}
BEGIN
IF RunEditDialog THEN AlrtDialog( 'Fin !!!!' );
END;
RUN( DlogTest );


Re2:ループからの脱出    与太郎
Wed Dec 9 9:01:06 2009

↓「可能です」って書いたけど、試してないので自信ないです。
  あと、ダイアログ表示中はMessageが使えませんね。


Re:ループからの脱出    与太郎
Tue Dec 8 23:57:35 2009

標準ダイアログだと、表示中はスクリプトが停止してしまいますが、
カスタム・ダイアログかモダン・ダイアログなら可能です。


ループからの脱出    石男
Tue Dec 8 22:23:22 2009

また、ひとつお題を...
リピート文の中でダイアログを使って、そのループから抜け出したいのですけど、ループ
されている間はずっとダイアログは表示されていて、他のことをしている感じなんですが

PROCEDURE xxxx ;
VAR
i : INTEGER;
flag : BOOLEAN;
BEGIN
flag := FALSE;
i := 0;
REPEAT
i := i+1;
Message( Concat( 'ただ今=', i, '/50' ) );
flag := YNDialog( 'やめますか?' );
UNTIL ( i = 50 ) OR ( flag = TRUE ) ;
END ;
RUN( xxxx ) ;

 これでイメージが掴めるでしょうか?当然、このままではYNDialogが何度も出てきます
し、その度にループが止まります。無理かな?


ビューポート内のプラグインについて    村のポンコツ屋
Tue Dec 8 22:13:05 2009

空メールを送ってしまいました。
訂正します。FSActLayerです。かんちがいでした。
ビューポート注釈に入る場合、必ず一つのビューポートを選択しますので、ビューポートのハンドルは
FSActlayerでよいのです。
どうもビューポート内では、注釈や枠がグループ化されているようです。
ビューポート内に入ると、注釈を選んだ場合は、そのグループ内に入り図形を追加している様子です。
図形を書き込みビューポートをでると、注釈のグループが閉じられビューポートを出るようです。
依って,
GetVPGroupParent(GroupHandle) のGroupHandleは、まさに字のごとくグループのハンドルです。
よく読んで下さい!!すみません
プラグインのハンドルであるParamHandでは、NILとなるわけです。
ここでも、プラグインのプロパティで移動と回転を行った場合、スクリプトを再実行しないようにしておけば
ビューポートに入った場合のみ、FSActLayerでビューポートハンドルは、取得できると思われます。
ということで、バグでも何でもなかったのでは?


ビューポート内のプラグインについて    村のポンコツ屋
Tue Dec 8 21:52:28 2009

村の


ビューポート内のプラグインについて    村のポンコツ屋
Tue Dec 8 18:33:03 2009

ビューポートの内にあるプラグインオブジェクトのビューポートハンドルを取得する方法が
分かりましたので報告します。
ParamHandがビューポート内にある場合、そのコンテナであるぴゅーポートのハンドルは、FActLayerで取得できるようです。試したのは VectorWorks Ver 12.5です。
私の最新バージョンは、2008ですがお得意様が、Ver 12.5 ですので主に12.5を使用しています。
同一のシートレイヤーに複数のビューポートを配置し、各ビューポートに注釈を付け加えて試しましたが、内包するビューポートのハンドルを、正確に返してき ます。なぜでしょうかね?全てのバージョンには通用しないかも?

ResultStatus:=GetCustomObjectInfo(ParamName,ParamHand,ParamRecordHand,WallHand);
IF (ResultStatus)&(ParamHand<>NIL)&(ParamRecordHand<>NIL) THEN
BEGIN
IF IsVPgroupContainedObject(ParamHand,2) THEN
BEGIN
Writeln('レイヤー名は',GetName(FActLayer));
Writeln('種類は',GetType(FActLayer));
END;
END;


Re4:ビューポート内のプラグインについて    与太郎
Mon Dec 7 12:58:19 2009

Ver.10以降なら、ResetObjectも試してみるべきかも知れません。

PIOが再描画されないのは、PIOまたはPIOが生成された領域の再描画が必要だという情報が、
ツールを終了するまでVW本体に送られないためだと思います。
ReDrawAllでも画面全体ではなく、必要な部分だけ再描画してるみたいなので。
コマンドだと良くてツールだとダメという理由は、VWの中の人に訊いてみないと判りません。

Ver.8.5の頃、同じようにPIOを生成するPITの再描画で悩みました。
結局、四角形の描き消しだけではダメだったので、ツール内でのループもやめて、
パラメータもファイルに保存という方法に落ち着きました。
最近のバージョンではそこまでする必要はないみたいですね。

ツールのパラメータ更新をすると、何故かPIOが再描画されなかった記憶もありますが、
これもたぶん最近のバージョンなら大丈夫なんでしょうね。


ビューポート内のプラグインについて    村のポンコツ屋
Mon Dec 7 11:45:57 2009

与太郎さんへ
ReDrawAllではだめでした。
四角形を描いて再描画、消して再描画する。これは大成功。しかしなぜこうなるの?


Re2:ビューポート内のプラグインについて    与太郎
Mon Dec 7 10:36:55 2009

それ以外に考えられる方法は、

1)生成したオブジェクトのBoundBoxと同じか少し大きいサイズの四角形を描いて再描画、
消して再描画する。

2)Counterの値さえスクリプト外に保存出来ればwhileループは不要なので、Counterの値を
ツールのパラメータ、ファイル、レコードなどに書き出す。

くらいです。


与太郎    Re:ビューポート内のプラグインについて
Mon Dec 7 10:07:48 2009

>村のポンコツ屋さん
石男さんへのレスだったんですけど、こっちへのレスと読めないこともないですね。

再描画の件は、ReDrawの代わりにReDrawAllではダメですか?


ビューポート内のプラグインについて    村のポンコツ屋
Mon Dec 7 1:01:26 2009

石男さんありがとうございます。
実は邪道かもしれせんが、同一のシートレイヤーに、異なるスケールサイズのビューポートを複数置く場合が多々ありまして、ビューポートに入らずに直接シー トレイヤーにコメントを書くこともあります。
そのために pUserScaleSize を追加しました。
与太郎さんありがとうございます。
>私はよくやるんですが、
オブジェクトは極力シンプルにして、生成用ツールで初期値の更新をするほうが簡単かも。
そうすると、縮尺や単位を考慮してPIOのサイズを変えられるし。

私も同感です。
これに関して、悩みがあります。
通り芯番号(PlugInObject)を連番で配置するツールを作りましたが、実行中に配置したプラグインを表示できません。プログラムを終了させれ ば、ちゃんと配置されています。プログラムの実行中に、生成したプラグインを表示する方法があるのでしょうか?
*****サンプル
PROCEDURE MARK;
LABEL 1;
CONST{生成するプラグインのデータベース情報}
ObjName='UPCO-通り芯記号';
Fld1='FrontTxt';
Fld2='CountTxt';
Fld3='RearTxt';
Fld4='MarkSize';
Fld5='ArcLW';
Fld6='LineLW';
{プログラム名称 UPCT-通り芯ナンバーリング
プログラムタイプツール
パラメーター
TextFrontTxt前置記号X
TextStartTxt初期値1
TextRearTxt後置記号
NumberMarkSize記号サイズ10
NumberArcLW記号線の太さ(mm)0.2
NumberLineLW分割線の太さ(mm)0.1
BOOLEANMarkAngleFix指定角度で描画true
NumberMarkAngle指定角度90
}
VAR
parmName:STRING;
parmRecordHand:HANDLE;
resultStatus:BOOLEAN;

X10,Y10,X11,Y11:REAL;
Counter:LONGINT;
MarkH,PickH:HANDLE;
VEC:VECTOR;
RD,LWArc,LWLine,RANG:REAL;
BigChr,ItString,Roop:BOOLEAN;
Numbering,SizeStr,ALWStr,LWStr:STRING;

{文字(abc・ABC)をカウンター数値に置き換えます。大文字小文字の判断も同時に行う。}
FUNCTION abc2Counter(Numbering:STRING;VAR BigChr:BOOLEAN;VAR Counter:LONGINT):BOOLEAN;
VAR
TxtLen,I,StartChr:INTEGER;
BEGIN
TxtLen:=Len(Numbering);
abc2Counter:=true;
FOR I:=1 TO TxtLen DO
IF (Ord(Copy(Numbering,I,1))>=65)&(Ord(Copy(Numbering,I,1))<=90) THEN
BigChr:=true
ELSE
abc2Counter:=false;
IF NOT abc2Counter THEN
BEGIN
abc2Counter:=True;
FOR I:=1 TO TxtLen DO
IF (Ord(Copy(Numbering,I,1))>=97)&(Ord(Copy(Numbering,I,1))<=122) THEN
BigChr:=false
ELSE
abc2Counter:=false;
END;
IF BigChr THEN
StartChr:=65
ELSE
StartChr:=97;
Counter:=0;
IF abc2Counter THEN
BEGIN
FOR I:=1 TO TxtLen DO
Counter:=Counter+(Ord(Copy(Numbering,I,1))-StartChr+1)*26^(TxtLen-I);
Counter:=Counter-1;
END;
END;

{カウンター数値と大文字小文字指定により、該当する文字列に置き換えます。}
PROCEDURE Counter2abc(Counter:LONGINT;BigChr:BOOLEAN;VAR Numbering:STRING);
VAR
expVar,TxtLen,StartNum,CNT:LONGINT;
ChrVar:LONGINT;
BEGIN
IF BigChr THEN
ChrVar:=65
ELSE
ChrVar:=97;

StartNum:=Counter;
Numbering:='';
WHILE StartNum>=26 DO
BEGIN
expVar:=1;
WHILE (StartNum DIV 26^expVar)>0 DO
BEGIN
CNT:=StartNum DIV 26^expVar;
expVar:=expVar+1;
END;
expVar:=expVar-1;
Numbering:=Concat(Numbering,Chr(CNT-1+ChrVar));
StartNum:=StartNum-CNT*26^expVar;
END;
Numbering:=Concat(Numbering,Chr((Counter MOD 26)+ChrVar));
END;

BEGIN
parmName:='BAD';
parmRecordHand:=nil;
resultStatus:=GetPluginInfo(parmName,parmRecordHand);
IF (resultStatus)&(parmRecordHand<>NIL) THEN
BEGIN{START}
PushAttrs;

SizeStr:=Num2StrF(pMarkSize);
ALWStr:=Num2StrF(pArcLW);
LWStr:=Num2StrF(pLineLW);
Numbering:=pStartTxt;
IF ValidNumStr(Numbering,Counter) THEN
BEGIN
ItString:=false;
END ELSE BEGIN
ItString:=abc2Counter(Numbering,BigChr,Counter);
IF NOT ItString THEN
BEGIN
SysBeep;
AlrtDialog('初期値の設定に間違い
初期値は、半角英数のみ使用可能
例 123又はabc又はABC');
GOTO 1;
END;
END;

Roop:=true;

WHILE Roop DO
BEGIN
GetPt(X10,Y10);
PickH:=PickObject(X10,Y10);
IF (PickH=NIL)|(GetType(PickH)<>86) THEN
BEGIN
IF ItString THEN
Counter2abc(Counter,BigChr,Numbering)
ELSE
Numbering:=Concat(Counter);
IF pMarkAngleFix THEN
MarkH:=CreateCustomObject(ObjName,X10,Y10,pMarkAngle)
ELSE
MarkH:=CreateCustomObject(ObjName,X10,Y10,0);
SetRField(MarkH,ObjName,Fld1,pFrontTxt);
SetRField(MarkH,ObjName,Fld2,Numbering);
SetRField(MarkH,ObjName,Fld3,pRearTxt);
SetRField(MarkH,ObjName,Fld4,SizeStr);
SetRField(MarkH,ObjName,Fld5,ALWStr);
SetRField(MarkH,ObjName,Fld6,LWStr);
SetCurrentObject(MarkH);
ResetObject(MarkH);{これでは表示しない}
HMove(MarkH,0,0);{コマンドパレット上では表示に成功した}
ReDraw;{これでは表示しない}
Counter:=Counter+1;
END ELSE BEGIN
Roop:=false;
END;
END;
1:
PopAttrs;
END;{END}
END;
RUN(MARK);


Re3:ビューポート内のプラグインについて    石男
Sun Dec 6 22:52:31 2009

>移動回転でスクリプトの実行を停止すれば...
確かに移動と回転での再実行と止めれば問題ないようです。それなら、ビューポート内の
スケールもきちんと取得できます。どうせなら...
>IF pScaleDraw THEN BEGIN〜を次のようにしますね(笑)
IF pScaleDraw THEN BEGIN
IF IsVPGroupContainedObject( ParamHand, 2 ) THEN
ScaleTxt:=Concat('S:1/', GetObjectVariableReal( GetVPGroupParent( ParamHand ),1003 ) )
ELSE ScaleTxt:=Concat('S:1/',GetLScale( ActLayer ) );
FillPat(1);
TextVerticalAlign(5);
TextSize(pScaleTxtSize);
TextOrigin(FrameWidth+Mil2LWSize(FLW)*0.5+Txtheight*ScaleTxtBlank,-FrameHight);
TextJust(1);
CreateText(ScaleTxt);
END;
HMoveForWard(hObj,True);
PopAttrs;
END;{END}
END;
RUN(AICM);

 こうすれば、このプラグインをビューポート内で使えばビューポートのスケールを拾う
し、ビューポートの外で使えばアクティブレイヤのスケールを拾います。pUserScaleSize
のパラメータを使わずにすみますよ。


ビューポート内のプラグインについて    村のポンコツ屋
Sun Dec 6 20:21:09 2009

皆様、早速のご指導ありがとうございます。説明不足でしたが、1点型オブジェクト(最後にアップします)
をいろいろ試しましたが、構造上のバグかではないかとおもわれます。プラグインプロパティの移動回転でスクリプトの実行を停止すれば実用上支障がないと思 い、これに変更しました。
**********************悩んでいたプログラム全文(改良点が有れば教えて下さい) ************************
PROCEDURE AICM;
CONST
{余白や丸めの設定値 文字のサイズより比率で設定している。}
PRGName='UPCO-サブタイトル';
ScaleTxtBlank=0.3;
FrameRRatio=0.3;
BoxHeight=1.1;
SidMargin=0.35;
{※ビューポート内で使用すると、外部よりビューポートを移動回転した場合、
実際のスケールサイズが取得できない。
依って、プロパティの移動回転の時、プログラムが再実行されないようにしておくこと。
プログラム名称 UPCO-サブタイトル
プログラムタイプ一点型オブジェクト
カテゴリーUPS-コメント
デフォルトクラス
プロパティーコメント挿入中心でクリック開始、ドラッグクリックで角度指定
パラメーター
TextSubTitleタイトル文字
NumberTitleTxtSize文字サイズ14
NumberFrameLW枠線の太さ(mm)0.45
BOOLEANScaleDraw縮尺を書くTRUE
BOOLEANUserScaleWriteスケールサイズを指定するFALSE
NumberUserScaleSize指定のスケール100
NumberScaleTxtSize縮尺文字サイズ8
}
VAR
ParamName:STRING;
ParamHand,ParamRecordHand,WallHand:HANDLE;
ResultStatus:BOOLEAN;

FLW,FrameWidth,FrameHight,FrameR:REAL;
RX1,RY1,RX2,RY2,Txtheight:REAL;
hObj,hVPInObj:HANDLE;
Title,ScaleTxt:STRING;
ScaleWrite:BOOLEAN;

{$INCLUDE UPS:ObjectAnalysis.vss}

PROCEDURE GetParameter;
BEGIN
{コメント}
IF pSubTitle='' THEN
Title:='Non Title'
ELSE
Title:=pSubTitle;
{線サイズ}
FLW:=pFrameLW*1000/25.4;
END;

BEGIN
ParamName:='BAD';
ParamHand:=NIL;
ParamRecordHand:=NIL;
ResultStatus:=GetCustomObjectInfo(ParamName,ParamHand,ParamRecordHand,WallHand);
IF (ResultStatus)&(ParamHand<>NIL)&(ParamRecordHand<>NIL) THEN
BEGIN
GetParameter;
PushAttrs;
FillPat(0);
PenPat(2);
TextVerticalAlign(3);
TextJust(2);
TextSize(pTitleTxtSize);
TextOrigin(0,0);
CreateText(Title);
hObj:=LNewObj;
Txtheight:=HHeight(hObj);
FrameWidth:=GetTextWidth(hObj)*0.5+Txtheight*SidMargin+Mil2LWSize(FLW)*0.5;
FrameHight:=Txtheight*BoxHeight*0.5+Mil2LWSize(FLW)*0.5;
FrameR:=Txtheight*FrameRRatio;
FillPat(1);
PenSize(FLW);
RRect(-FrameWidth,FrameHight,FrameWidth,-FrameHight,FrameR,FrameR);
IF pScaleDraw THEN
BEGIN
IF pUserScaleWrite THEN
ScaleTxt:=Concat('S:1/',pUserScaleSize)
ELSE
ScaleTxt:=Concat('S:1/',GetLScale(ActLayer));
FillPat(1);
TextVerticalAlign(5);
TextSize(pScaleTxtSize);
TextOrigin(FrameWidth+Mil2LWSize(FLW)*0.5+Txtheight*ScaleTxtBlank,-FrameHight);
TextJust(1);
CreateText(ScaleTxt);
END;
HMoveForWard(hObj,True);
PopAttrs;
END;{END}
END;
RUN(AICM);


Re2:続番号スタンプ    与太郎
Sun Dec 6 12:49:50 2009

途中で送ってしまいました...

私はよくやるんですが、
オブジェクトは極力シンプルにして、生成用ツールで初期値の更新をするほうが簡単かも。
そうすると、縮尺や単位を考慮してPIOのサイズを変えられるし。


Re:続番号スタンプ    与太郎
Sun Dec 6 12:41:13 2009

どうも1点型と2点型がごっちゃになってたようで...
石男さんの書いてるように、
1点型PIOの生成時にはGetParent(objHand)は、NILになりますねえ。
プロパティを「移動すると、コマンドを実行する」に変えても、生成時にもう一度スクリプト
を実行するのは無理みたいです。
ただし、壁の中に生成するとスクリプトが2回実行されます。2回目にはGetParent(objHand)
は壁のハンドルになります。初回に壁のハンドルが変えらないのは、仕様なのかバグなのか。
PIOを壁の厚みに合わせるという要求は、けっこうありそうなのに。
あと、壁の中でPIOを移動しても、スクリプトは実行されません(1点型でも2点型でも)。


Re:ビューポート内のプラグインについて    石男
Sun Dec 6 2:31:11 2009

>GetObjectVariiableReal
>GetLScal
スペルが違いますよ。
下のScriptでビューポートのスケールサイズが取れますが、このプラグインもリンクした
ビューポートを作っても元のレイヤのスケールを拾います。
うまく言えませんが...

PROCEDURE xxxxxx ;
VAR
objHand, recHand, wallHand : HANDLE ;
objName, ScaleText : STRING ;
{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
IF GetCustomObjectInfo( objName, objHand, recHand, wallHand ) THEN BEGIN
IF IsVPGroupContainedObject( objHand, 2 ) THEN
ScaleText:=Concat('S:1/', GetObjectVariableReal( GetVPGroupParent( objHand ),1003 ) )
ELSE ScaleText:=Concat('S:1/',GetLScale( ActLayer ) );
MoveTo( 0, 0 );
CreateText( ScaleText );
END ;
END ;
Run( xxxxxx ) ;

簡単な1点型のプラグインオブジェクトですのでお好きなように直して使ってください。


ビューポート内のプラグインについて    村のポンコツ屋
Sat Dec 5 23:40:14 2009

図面のサブタイトルを書くプラグインを作っていますが、ビューポート注釈で使用した場合の、スケールサイズの取得方法が解りません。現在はビューポートを 移動したり編集するとスケールサイズが、0になります。

VAR
ObjectHandle:プラグイン内での自身のハンドル(ParamHand)
ViewPortHandle:
ScaleText:スケールサイズ文字
***********************************************
IF IsVPGroupContainedObject(ObjectHandle,2) THEN
ScaleText:=Concat('S:1/',GetObjectVariiableReal(GetVPGroupParent(ObjectHandle),1003));
ELSE
ScaleText:=Concat('S:1/',GetLScal(ActLayer));
***********************************************
GetVPGroupParent(ObjectHandle)のハンドルがNILとなりビューポートのハンドルが取得できません。
何かよい方法が有りませんか?


続番号スタンプ    石男
Sat Dec 5 17:45:01 2009

2点型ならこれで大丈夫でした、2009のMacでも...
PROCEDURE AutoNumbering2P ;
CONST
krecordname = '#2PAutoNumbering';
kfieldname = 'number';
VAR
objHand, recHand, wallHand, txtHd : HANDLE ;
objName : STRING ;
number, i : LONGINT ;
size, txtheight, ang : REAL ;
p : VECTOR;
{PLINELENGTH}
{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
IF GetCustomObjectInfo( objName, objHand, recHand, wallHand ) THEN BEGIN
p := Ang2Vec( 0 , PLINELENGTH ) ;
ang := Vec2Ang( p );
ArcByCenter( 0, 0, PSIZE/2, 0, 360) ;
MoveTo( 0, 0 ) ;
CreateText( Num2Str( 0, PNUMBER ) ) ;
txtHd := LNewObj ;
SetFPat( txtHd, 0 ) ;
SetTextJust( txtHd, 2 ) ;{center}
SetTextVerticalAlign( txtHd, 3 ) ;{Text centerline}
HRotate( txtHd, 0, 0, ang );
SetRField( GetObject(krecordname), krecordname, kfieldname, Concat( PNUMBER+1) ) ;
END ;
END ;
Run( AutoNumbering2P ) ;


Re16:番号スタンプ    石男
Sat Dec 5 17:35:55 2009

こんなやり方じゃだめですか?状況は変わらず...
PROCEDURE AutoNumbering ;
CONST
krecordname = '#AutoNumbering';
kfieldname = 'number';
VAR
objHand, recHand, wallHand, txtHd, defParameterHand : HANDLE ;
objName : STRING ;
number, i : LONGINT ;
size, txtheight : REAL ;

{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
size := psize ;{パラメータ=size REAL}
number := pnumber ;{パラメータ=number INTEGER}

IF GetCustomObjectInfo( objName, objHand, recHand, wallHand ) THEN BEGIN
SetParameterVisibility( objHand, 'IsNew', TRUE ) ;{パラメータ=IsNew BOOLEAN}
ArcByCenter( 0, 0, size/2, 0, 360) ;
MoveTo( 0, 0 ) ;
CreateText( Num2Str( 0, number ) ) ;
txtHd := LNewObj ;
SetFPat( txtHd, 0 ) ;
SetTextJust( txtHd, 2 ) ;{center}
SetTextVerticalAlign( txtHd, 3 ) ;{Text centerline}
IF ( GetParent( GetObject( krecordname ) )<>NIL ) AND PISNEW THEN BEGIN
SetRField( GetObject(krecordname), krecordname, kfieldname, Concat( number+1) ) ;
END;
END ;
END ;
Run( AutoNumbering ) ;
'#AutoNumbering'は2009のMacでは通りましたが、11.5のwinは通りません


Re15:番号スタンプ    与太郎
Fri Dec 4 17:34:07 2009

IsNewCustomObject は使ったことがないですが、
パラメータを1個使えば、プラグイン・オブジェクト(PIO)が新規のものか既存のものかを
判別することは出来ます。
パラメータのデフォルト値を決めておいて(これは絶対に変えてはいけない)、
PIOのパラメータがデフォルト値なら他の値に書き換えるという方法です。
パラメータがデフォルト値なら新規PIO、そうでなければ既存のPIOということになります。

って、無理やりレス付けてみました。


Re14:番号スタンプ    石男
Fri Dec 4 8:09:56 2009

>GetParent(objectHand)
>ですが、常にNILを返すようです。
ごめんなさい、常にNILじゃないでした...、外側のオブジェクトのハンドルが返ります。
1点型の時は、NILにはならないようです。

>こちらではこのお題で何レスまで引っ張れるでしょうかね
いや、これで終わりにしましょう...


Re13:番号スタンプ    与太郎
Thu Dec 3 23:23:04 2009

>>GetParent(objectHand)
>ですが、常にNILを返すようです。
それはおかしいですよ。
Re11に書いたように、プラグイン・オブジェクトの外側のオブジェクト(レイヤ、グループ、シンボル、壁など)
のハンドルが返るはずです。

ところで、VW談話室では管理人さんが3桁のレスを目標に話題を振ってます。
こちらではこのお題で何レスまで引っ張れるでしょうかね。


Re12:番号スタンプ    石男
Thu Dec 3 21:49:34 2009

どうも、2008より仕様が変わってしまったようです。もっとも、英文の翻訳が怪しいので
内容の把握が完璧とは言えませんが...
>FUNCTION IsNewCustomObject( objectname : STRING ):BOOLEAN ;
前はこれが使えていたようです。やはり、今は常にTRUEです。
>GetParent(objectHand)
ですが、常にNILを返すようです。
残念ながら現状はこのようです...。


Re11:番号スタンプ    与太郎
Sat Nov 28 2:06:47 2009

オブジェクトが生成されたときにはGetParent(objectHand)でレイヤ、シンボル、
グループなどのハンドルが返って来るけど、ツールをクリックしたときはNILなので、
NILのときにはパラメータをインクリメントしなければ良いのでは。


Re10:番号スタンプ   masafumi
Fri Nov 27 22:48:38 2009

2009デモ版(Win)でも石男さんと同様の状態ですね。

初めてツールをクリックした時は普通にインクリメントされますが、
ツールの選択を解除後に再びツールをクリックした時は、最初の数字
が+3され、その後はまた普通にインクリメントされます。

2009で一点型オブジェクトに変更があったのですかねぇ。


Re9:番号スタンプ    石男
Fri Nov 27 21:54:53 2009

与太郎さん

何だか申し訳ございませんでした。詳細なレポートをしていただいて...。
私の言葉足らずの点がありました、ごめんなさい。

一点型オブジェクトの場合、最初から続けて実行させると1,2,3...というようにきちんと
インクリメントします。一度、使用をやめて新たに使う時に初期状態の「1」にもどして
も「3」に変わってしまいますが、そのまま使えば4,5,6...とインクリメントしていくの
でその点は良いのかと...。
一点型イベントの場合、「1」が「2」となります。

結局、スクリプトが何回実行されたかで制御しようと試みましたが、無理でした。
FUNCTION IsNewCustomObject( objectname : STRING ):BOOLEAN ;
というのがありますが、常にTRUEしか返さず使えません。


Re8:番号スタンプ    与太郎
Fri Nov 27 17:49:39 2009

2008デモ版(Mac)で試したら、ちゃんとインクリメントされました。
インクリメントされないのは、krecordname = '#AutoNumbering'; とプラグイン名が違ってるとか?

最初は2点型で作ってたので一点型でもやってみましたが、問題ないようです。
ただ、デバッガで観察して気付いたのは、
一点型ではツール・アイコンを選択した時点でスクリプトが実行されるということです。
(オブジェクトの輪郭を計算するためだと思うのですが。)
初期状態(Number=1)でツールをクリックするとスクリプトが実行されて、Number=2になります。
ところが、最初のオブジェクト生成時のプロパティ・ダイアログではNumber=1と表示されています。
その後もツールをクリックする度にスクリプトが実行されて、Numberがインクリメントされますが、
オブジェクト生成時にはインクリメントされる前の値に戻っています。
結果的には正しいのですが...

2点型ではツールをクリックしただけではスクリプトは実行されません。


Re7:番号スタンプ    石男
Fri Nov 27 10:01:33 2009

ver.11.5(win)は、途中からでも大丈夫でした...
Macの方はIntelに変えたあたりで仕様が大きく変わってしまったのでしょうかね。


Re6:番号スタンプ    与太郎
Fri Nov 27 8:43:23 2009

ver.11.5(Mac)だと1からでも、途中で番号を変えてもちゃんとインクリメントされました。
デバッグ・モードで、何回実行されてるか確かめるしかないですね。


Re5:番号スタンプ    石男
Thu Nov 26 22:48:21 2009

masafumiさん

アドバイスすみません、なぜでしょう?masafumiさんのやりかたも、下のやりかたも同じ
でした。両方ともパラメータの初期値を変わり、増えていきますが...。
ツールを配置する前にパラメーターを呼び出して、例えば「1」を入力すると配置された時には「3」に変わっています。ということは、2回呼び出されてい る?
他のやり方も試してもうまくいかず、このままで取りあえず使っています(笑)

ちなみに2009のMac版だからって話かな...


Re4:番号スタンプ   masafumi
Thu Nov 26 19:00:22 2009

スペースを「 _ 」に変換したら、文中のスペースがすべて「 _ 」になってしまった。(^_^;)
文中の「 _ 」はすべて削除して実行して下さい。トホホ・・・。


Re3:番号スタンプ   masafumi
Thu Nov 26 18:54:37 2009

こんにちは、石男さん。

バックナンバーの「1999-2002年」の先頭項目の関連記事が参考になりませんか?。
GetPluginInfoでパラメータの初期値を一緒に変えれば良かったような気がします。


__IF_GetCustomObjectInfo(_objName_,_objHand_,_recHand_,_wallHand_)_THEN_BEGIN
____ArcByCenter(_0,_0,_size/2,_0,_360)_;
________・・・
________・・・
________・・・
____SetRField(_defParameterHand,_krecordname,_kfieldname,_Concat(_number+1)_)_;

____{下の2行を追加。パラメータの初期値を変える}
____if_GetPluginInfo(objName,recHand)_then
________SetRField(GetObject(objName),GetName(recHand),kfieldname,Concat(_number+1));
__END;


ちなみに石男さんのサンプル、私の環境で実行しても数がインクリメントされません?。なぜ?。


Re2:番号スタンプ    石男
Tue Nov 24 16:27:11 2009

与太郎さん
いつもすみません、プログラムをアップします。
PROCEDURE AutoNumbering ;
CONST
_krecordname = '#AutoNumbering';
_kfieldname = 'number';
VAR
_objHand, recHand, wallHand, txtHd, defParameterHand : HANDLE ;
_objName : STRING ;
_number, i : LONGINT ;
_size, txtheight : REAL ;

{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
_size := psize ;{パラメータ=size REAL}
_number := pnumber ;{パラメータ=number INTEGER}
__IF GetCustomObjectInfo( objName , objHand , recHand , wallHand ) THEN BEGIN
____ArcByCenter( 0, 0, size/2, 0, 360) ;
____MoveTo( 0, 0 ) ;
____CreateText( Num2Str( 0, number ) ) ;
____txtHd := LNewObj ;
____SetFPat( txtHd, 0 ) ;
____SetTextJust( txtHd, 2 ) ;{center}
____SetTextVerticalAlign( txtHd, 3 ) ;{Text centerline}
____defParameterHand:= GetObject( krecordname ) ;
____SetRField( defParameterHand, krecordname, kfieldname, Concat( number+1) ) ;
__END ;
END ;
Run( AutoNumbering ) ;

これでやると1から使用すれば、2,3...とパラメーター=numberが増えてくれます。
けど、途中の数から始めるとおかしくなります。


Re:番号スタンプ    与太郎
Tue Nov 24 14:41:48 2009

通常、スクリプトのはじめに、
result:= GetCustomObjectInfo(objectName, objectHand, recordHand, wallHand);
でプラグイン・オブジェクトの情報を調べます。
objectHandは生成されるオブジェクト自身のハンドル、recordHandはそのオブジェクトのパラメータ・
レコードのハンドルです。

プラグイン・オブジェクト自身のパラメータを上書きするには、
SetRField(objectHand, recordName, fieldName, newParameter);
とします。
recordNameはプラグインの名前で、普通はrecordName = '番号スタンプ';のように定数にすると思い
ますが、GetName(recordHand)で調べることも出来ます。
fieldNameはパラメータの名前、newParameterは書き込む文字列です。

プラグイン・オブジェクトのパラメータを書き換えると、何かのイベントが発生してスクリプトが
もう一度実行されるので、その辺がループ(?)の原因ではないでしょうか。

スクリプトの後処理で、デフォルト・パラメータのほうを
SetRField(defParameterHand, recordName, fieldName, Concat(num + 1));
のように書き換えれば、次回の番号はnum+1になるし、オブジェクトのパラメータは変えずに済みます。
デフォルト・パラメータのハンドルは、defParameterHand:= GetObject(recordName);で得られます。


番号スタンプ    石男
Tue Nov 24 11:06:41 2009

1,2,3,4...というように自動的に番号が増えていく、番号スタンプ(1点型オブジェクト)
を考えているのですが、パラメータの初期値をSetRfieldで書き換えていく際に変なループ
に陥ります。
どのように初期値を増やしていったら良いのか、分かる方がいれば教えてください。


PluginLibraryRoutinensもあるリファレンス    石男
Tue Nov 17 12:10:25 2009

最近見つけましたPluginLibraryRoutinesの機能拡張の説明です
ご本家Nemetschekのトップページから次のように行ってください
Support--Vectorscript--Documentation--VectorScriptFunctionReference--
AnnotatedFuntionReference
通常の手続き、関数と一緒に機能拡張が並んでいます。きちんと英語で説明されていま
す。2010のも見られるので新し物好きな方にはお勧めです。


Re:1〜3m間隔でランダムに四角形を並べる    ゴンスケ
Thu Oct 29 23:06:55 2009

もし、VectorScript内の四角形描画コマンドを増殖させたいということなら;

6×6の四角形をシンボル登録する。
VectorScriptで書き出す。
Excelで、基準点の座標をランダムに発生させる計算式をつくる。
これらのセルの計算結果と、関数CONCATENATEを使って、別のセルにSymbol文の形で書き込む。
(このとき、基準点間間隔が、6+1〜3ではなく、6×√2×(1〜2の間になるように
 ランダマイズ)のようにすれば、干渉を避けられやすいのではないかと思う。
 最低間隔が√2になってしまうけれど。)
セルをずるずるっとコピーして、シンボルを増殖させる。
発生したSymbol文だけをずるずるっとコピーして、
 Excelで作った部分をVectorScriptファイルに挿入する。
VectorWorksに読み込み、領域からはみ出したものは、手動で削除。

(シンボル登録する理由は、基準点の座標を指定すればよいので、2点を指定する
 Rectを並べるより、見た目がスッキリするから。)

ただし、面的に配置していくのは、けっこう難しいかもしれない。
あたかもランダムにおいたように見える、という状態ならできそうな気がする。

ところで;
質問時、与太郎さんが書いてくれたような質問内容が分かる題名を書いてくださいね。
また、この倶楽部には、初心者を自称する人がたくさん出没するので、初心者M78とか
識別コードを付加するとよいと思いますよ。


Re2:1〜3m間隔でランダムに四角形を並べる    与太郎
Thu Oct 29 20:20:57 2009

ブラウザによっては、×と□の文字幅が違うんですね。
下の絵で、龗は四角形が侵してはいけない領域です。幅は1mです。
囗の部分から四角形は出てはいけません。この部分は7m×7mです。
この中であれば、6m×6mの四角形をどこに描いても、隣の四角形との間隔は1〜3mに収まります。

囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗
囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗

囗の領域内の中心に描かれた6m×6mの四角形は、上下左右に0.5mだけランダムに動けるということです。
下のスクリプトで描けます。(「__」はタブに置き換えてください。)

procedure test;
const
__NumX = 20;{ 個数 }
__NumY = 20;{ 個数 }
__RectWd = 6.0;{ m }
__RectHt = 6.0;{ m }
__MinMargin = 1.0;{ m }
__MaxMargin = 3.0;{ m }
__PitchX = RectWd + MaxMargin - MinMargin;{ =8.0m }
__PitchY = RectHt + MaxMargin - MinMargin;{ =8.0m }
__MinSwingX = (RectWd - PitchY) / 4 ;{ =-0.5m }
__MinSwingY = (RectHt - PitchY) / 4 ;{ =-0.5m }
__MaxSwingX = -MinSwingX;{ =0.5m }
__MaxSwingY = -MinSwingY;{ =0.5m }
var
__iX, iY__:integer;
__x, y, dX, dY, hlfWd, hlfHt__:real;
begin
__hlfWd:= RectWd / 2;
__hlfHt:= RectHt / 2;
__for iY:= 1 to NumY do begin
____for iX:= 1 to NumX do begin
______x:= (iX - (NumX + 1) / 2) * PitchX;
______y:= (iY - (NumY + 1) / 2) * PitchY;
______dX:= MinSwingX + Random * (MaxSwingX - MinSwingX);
______dY:= MinSwingY + Random * (MaxSwingY - MinSwingY);
______Rect(x+dX-hlfWd, y+dY+hlfHt, x+dX+hlfWd, y+dY-hlfHt);
____end;
__end;
__DSelectAll;
end;
Run(test);

描いた結果がランダムに見えるかどうか...


   初心者
Thu Oct 29 16:37:41 2009

はじめまして。
すいません。
書き方を少し間違ってしまったようです。
scriptとして書き出しをしてそれに付加する形でどんどんscriptに要素を追加していきたいんですけどどうしたらいいですか?

色々勉強したんですけどわからなくて・・・


Re:1〜3m間隔でランダムに四角形を並べる    与太郎
Thu Oct 29 9:28:08 2009

8mピッチで四角形を並べて、±0.5mランダムに移動させたほうが簡単ですね。


1〜3m間隔でランダムに四角形を並べる    与太郎
Thu Oct 29 8:45:30 2009

初心者さん、はじめまして。

とりあえず、下のように1m間隔で7m×7mの領域を設定して、
その範囲から出ないようにランダムに四角形を描けば、間隔を1m〜3mに出来ます。

□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
×××××××××××××××××××××××××××××××××××××××
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
×××××××××××××××××××××××××××××××××××××××
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□
□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□


下のように領域をずらして設定したほうが、よりランダムに見えます。

×□□□××××××□□□×□□□×□□□
×□□□×□□□××××××□□□×□□□
×□□□×□□□×□□□××××××□□□
×××××□□□×□□□×□□□×××××
□□□××××××□□□×□□□×□□□×
□□□×□□□××××××□□□×□□□×
□□□×□□□×□□□××××××□□□×
××××□□□×□□□×□□□××××××
□□××××××□□□×□□□×□□□××
□□×□□□××××××□□□×□□□×□
□□×□□□×□□□××××××□□□×□
×××□□□×□□□×□□□××××××□
□××××××□□□×□□□×□□□×××
□×□□□××××××□□□×□□□×□□
□×□□□×□□□××××××□□□×□□
××□□□×□□□×□□□××××××□□
××××××□□□×□□□×□□□××××


   初心者
Thu Oct 29 2:39:23 2009

はじめまして VectorScript初心者のものです。
みなさんに質問したいのですが、6m角の四角形をある範囲のなかにランダムにちりばめたいんですがどうしたらいいですか? 
また付加条件として四角形同士の隣り合う間隔を1m〜3mぐらいにしたいんですけどどうしたらいいですか?


もしよければ助けてください。お願します。


Re4:配列の同じ要素を削除    石男
Wed Oct 28 17:12:19 2009

サブルーチンの中でDYNARRAYはALLOCATEが出来ないようになっているようです。
配列のリサイズだけではなく初期化さえダメでした。
>CompArrayを実行した次の行でAllocateしています
これを行うと「VectorScriptの警告」が出る(私の場合この設定ははずせない)ので
topの分だけ配列を回すことにしました。
同じ要素を削除せずともこのルーチンで充分です、助かりました。


Re3:配列の同じ要素を削除    与太郎
Wed Oct 28 11:16:50 2009

procedure CompArray の中では配列のリサイズをしようとしましたが、
引数で渡した配列のリサイズは出来ませんでした。
最後の{__Allocate num[min..top];__}はその名残です。
しかたないのでCompArrayを実行した次の行でAllocateしています。


Re2:配列の同じ要素を削除    石男
Mon Oct 26 22:27:26 2009

>与太郎さん
いつもどうもすみません。自力でやっていたのですが途中で断念してしまいお願いしてし
まいました。
膨大なデータは扱わない予定なのですが、最初にソートしてからの方が良さそうですね。


Re:配列の同じ要素を削除    与太郎
Mon Oct 26 18:28:48 2009

単純に、配列の最初のほうに重複しなかった要素を並べてゆきます。
データが少なければこれで大丈夫だと思います。
データが膨大な場合は一度ソートしてから圧縮し、元の順番にソートし直すなどして、
数値の比較回数を減らす工夫が必要です。

procedure test;
const
__Tb = Chr(9);
var
__i__:longint;
__min, max ,min2, max2, max0, min0__:integer;
__num__:dynArray[] of real;
__tmpDt__:dynArray[] of real;
__
procedure CompArray(var num:dynArray[] of real; var top:integer);
{ 重複する要素を削除して配列を圧縮する }
var
__i, j__:longint;
__min, max ,min2, max2__:integer;
begin
__GetArrayDimensions(num, min, max ,min2, max2);
__top:= min;
__for i:= min+1 to max do begin
____Message('圧縮中... ', i-min, '/', max-min);
____j:= min;
____while (j < top) & (num[i] <> num[j]) do
______j:= j + 1;
____if num[i] <> num[j] then begin
______top:= top + 1;
______num[top]:= num[i];
____end;
__end;
{__Allocate num[min..top];__}
end;{CompArray}
__
begin{test}
__i:= 0;
__Allocate num[i..20];
__num[i]:= 10;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= 50;
__i:= i + 1; num[i]:= -23;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= -.5;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= 10;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= 50;
__i:= i + 1; num[i]:= -23;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= -.5;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= 10;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= 50;
__i:= i + 1; num[i]:= -23;
__i:= i + 1; num[i]:= 123.5;
__i:= i + 1; num[i]:= -.5;
__i:= i + 1; num[i]:= 123.5;
__GetArrayDimensions(num, min, max0 ,min2, max2);
__Allocate tmpDt[min..max0];
__for i:= min to max0 do
____tmpDt[i]:= num[i];
__
__CompArray(num, max); { 配列を圧縮する }
__Allocate num[min..max];
__
__WriteLn('index', Tb, 'old', Tb, 'new');
__for i:= min to max do
____WriteLn(i, Tb, tmpDt[i], Tb, num[i]);
__for i:= max+1 to max0 do
____WriteLn(i, Tb, tmpDt[i], Tb, '---');
__WriteLn('end.');
__Message('終了! 結果は「Output.txt」に書き出しました。');
end;{test}
Run(test);


配列の同じ要素を削除    石男
Mon Oct 26 14:29:37 2009

REAL型の配列で同じ要素を削除して新しい配列を作るにはどうしたら良いでしょうか?
要素{10, 123.5, 50, -23, 123.5, -0.5, 123.5 }
|
要素{10, 123.5, 50, -23, -0.5 }
このような感じでソートはせずに重複している要素を削除するだけで配列を小さくしたい
のです。


Re:2つの3D基準点でビューを設定する    与太郎
Mon Oct 19 19:50:46 2009

対象物からの距離と方向角でアングルを設定するスクリプトを、コマンドにしてみました。
下のアドレスからダウンロード出来ます。
http://www6.ocn.ne.jp/~kstools/samples/AngleSetting.htm


Re3:壁と直線の交点    与太郎
Sat Oct 17 8:37:00 2009

>ハイブリッドの壁もGetSegPt,Get2DPtでいけるとは...

Ver.9で拘束機能が導入されたとき、図形の種類に関係なく頂点を指定する必要があったので、
ほとんどの図形にGet2DPtが対応したようです。


Re2:壁と直線の交点    石男
Fri Oct 16 18:07:29 2009

与太郎さん
ありがとうございました。
GetSegPtは壁の中心座標ですね。Get2DPtなら壁の6個の座標を求められますね。
ちなみに1=中心始点,2=中心終点,3=右始点,4=左始点,5=右終点,6=左終点
ハイブリッドの壁もGetSegPt,Get2DPtでいけるとは...


Re:壁と直線の交点    与太郎
Fri Oct 16 17:19:30 2009

>下の手はかなり良いものだと思いますよ。
石男さん、ありがとうございます。
正直、自分でもそう思いました(自画自賛)。
視点側の3D基準点を選択するコマンドと併用すると便利です。
視点の座標をデータパレットで変えながらアングルを調整出来ます。

壁の座標ですが、
寸法線と同様にGetSegPtとGet2DPtで判ります。(1:始点、2:終点)
Get2DPtなら円弧壁の端点と円の中心も判ります。(1:円の中心、2:始点、3:終点)
下のスクリプトで、図形の2DPtの位置とIndex番号との関係を調べられます。

procedure test;
{ 図形の2DPtに基準点を打つ }
label
__999;
var
__h__:handle;
__x, y, xL, yL__:real;
__i, n__:integer;
begin
__h:= FSActLayer;
__xL:= 123456789.1; yL:= -xL;
__n:= 0;
__if h = nil then begin
____AlrtDialog('アクティブレイヤの図形を選択して下さい。');
____Goto 999;
__end;
__for i:= 1 to 20 do begin
____Get2DPt(h, i, x, y);
____if not EqualPt(x, y, xL, yL) then begin
______n:= n + 1;
______NameClass(Concat('2DPt-', n));
______Locus(x, y);
______xL:=x; yL:= y;
____end;
__end;
__Message(n, '個の点があります。');
999:
end;
Run(test);


壁と直線の交点    石男
Fri Oct 16 14:39:59 2009

>与太郎さん
 下の手はかなり良いものだと思いますよ。

壁ツールで書いた壁とそれを横切る直線の交点を求めるのにはどうしたら良いのでしょう
か?実際の作図では簡単にいけますが、スクリプトでは???
壁を書く時、Wallで左右の始点、終点を指定するのにGetWallに相当するものがありません
どうしたら良いのか、お願いします。


2つの3D基準点でビューを設定する    与太郎
Thu Oct 15 16:35:35 2009

手動でもスクリプトでも、オブジェクトを「見る角度」を設定するのは難しいです。
思いどおりに設定するのは無理じゃないかと思ってましたが、
5年前くらいにSetViewVectorについての書き込みがあったのを、今日思い出しました。
これなら対象物と視点の座標から「見る角度」を設定出来ます。

procedure SetViewByPoints;
{ 2つの3D基準点でビューを設定する }
label
__999;
const
__Camera = 'Camera Position';
__Target = 'Target position';
__Loc3DObj = 9;
var
__hC, hT__:handle;
__xC, yC, zC, xT, yT, zT__:real;
begin
__hC:= GetObject(Camera);
__if (hC = nil) | (GetType(hC) <> Loc3DObj) then begin
____AlrtDialog(Concat('"', Camera, '"という名前の3D基準点がありません!'));
____GoTo 999;
__end;
__hT:= GetObject(Target);
__if (hT = nil) | (GetType(hT) <> Loc3DObj) then begin
____AlrtDialog(Concat('"', Target, '"という名前の3D基準点がありません!'));
____GoTo 999;
__end;
__GetLocus3D(hC, xC, yC, zC);
__GetLocus3D(hT, xT, yT, zT);
__DoMenuTextByName('Projection', 3);
__SetViewVector(xC, yC, zC, xT, yT, zT, 0, 0 , 1);
999:
end;
Run(SetViewByPoints);

対象物の中心に「Target position」という名前の3D基準点を、
視点位置には「Camera Position」という名前の3D基準点を作って、
スクリプトを実行してください。
実行後は画面が透視投影になります。


Re6:寸法線の編集    耕
Thu Aug 27 14:44:01 2009

与太郎様、ありがとうございます。
SetBinaryConstraintを使って、希望通りに作ることができました!
ただDelObject(h2);をすると、h1まで消えてしまったので少し変更しました。
MiniCad6以来のユーザーですが、ずっと自己流(さらに自分専用)で変かもしれませんが、
下記に報告させていただきます。
ありがとうございました。

PROCEDURE IDOU;
VAR
MGX1,MGY1,MGX2,MGY2,MOVX,MOVY:REAL;
OBJ1:HANDLE;

FUNCTION PTMOVE(M:HANDLE):BOOLEAN;
VAR
PX,PY,PVR,SX1,SY1,SX2,SY2,LX,LY:REAL;
PPP,GLS,GLW,PVN,DMU:INTEGER;
N,L:HANDLE;
result:BOOLEAN;
Begin
__ResetObject(M);
__{四角形:多角形に変換}
__IF GetType(M)=3 THEN BEGIN
____GLW:=GetLW(M);GLS:=GetLS(M);
____N:=MakePolygon(M);
____DelObject(M);
____M:=N;
____SetLW(M,GLW);SetLS(M,GLS);
__END;
__{多角形・曲線}
__IF (GetType(M)=5) OR (GetType(M)=21) THEN BEGIN
____FOR PPP:=1 TO GetVERTNUM(M) DO BEGIN
______GetPOLYPT(M,PPP,PX,PY);
______IF PtInPoly(PX,PY,OBJ1) THEN BEGIN
________IF GetType(M)=21 THEN BEGIN
__________GetPolylineVertex(M,PPP,PX,PY,PVN,PVR);
__________SETPolylineVertex(M,PPP,PX+MOVX,PY+MOVY,PVN,PVR,TRUE);
________END ELSE BEGIN
__________SetPolyPt(M,PPP,PX+MOVX,PY+MOVY);
________END;
______END;
____END;
__END;
__{寸法線}
__IF GetType(M)=63 THEN BEGIN
____GetSegPt1(M,SX1,SY1);
____GetSegPt2(M,SX2,SY2);
____IF (PtInPoly(SX1,SY1,OBJ1) AND PtInPoly(SX2,SY2,OBJ1)) THEN BEGIN
______HMove(M,MOVX,MOVY);
____END ELSE BEGIN
______IF PtInPoly(SX1,SY1,OBJ1) THEN BEGIN
________Locus(SX1+MOVX,SY1+MOVY);
________L:=LNewObj;
________result:=SetBinaryConstraint(1,M,L,1,-1,1,-1,0,0);
________N:=GetBinaryConstraint(1,M,L,1,-1,1,-1,0,0);
________DeleteConstraint(M,N);
________DelObject(L);
______END;
______IF PtInPoly(SX2,SY2,OBJ1) THEN BEGIN
________Locus(SX2+MOVX,SY2+MOVY);
________L:=LNewObj;
________result:=SetBinaryConstraint(1,M,L,2,-1,1,-1,0,0);
________N:=GetBinaryConstraint(1,M,L,2,-1,1,-1,0,0);
________DeleteConstraint(M,N);
________DelObject(L);
______END;
____END;
__END;
__{直線}
__IF GetType(M)=2 THEN BEGIN
____GetSegPt1(M,SX1,SY1);
____GetSegPt2(M,SX2,SY2);
____IF PtInPoly(SX1,SY1,OBJ1) THEN SetSegPt1(M,SX1+MOVX,SY1+MOVY);
____IF PtInPoly(SX2,SY2,OBJ1) THEN SetSegPt2(M,SX2+MOVX,SY2+MOVY);
__END;
__{シンボル}
__IF GetType(M)=15 THEN BEGIN
____GetSymLoc(M,PX,PY);
____IF PtInPoly(PX,PY,OBJ1) THEN HMove(M,MOVX,MOVY);
__END;
__{円:変形ナシ}
__IF GetType(M)=6 THEN BEGIN
____HCenter(M,PX,PY);
____IF PtInPoly(PX,PY,OBJ1) THEN HMove(M,MOVX,MOVY);
__END;
__ResetObject(M);
END;

BEGIN
__GetRect(MGX1,MGY1,MGX2,MGY2);
__Poly(MGX1,MGY1,MGX1,MGY2,MGX2,MGY2,MGX2,MGY1,MGX1,MGY1);
__OBJ1:=LNewObj;
__SetLS(OBJ1,-2);SetPenFore(OBJ1,65535,0,0);
__SetDSelect(OBJ1);
__Redraw;
__PTDialog('','0','0',MOVX,MOVY);
__ForEachObjectInLayer(PTMOVE,2,1,0);
__DelObject(OBJ1);
END;
Run(IDOU);


Re5:寸法線の編集    与太郎
Thu Aug 27 12:58:15 2009

同一点拘束を使った変形の例です。
SetBinaryConstraintの4番目のパラメータを1にすれば、始点の変更になります。

procedure test;
{ 直線、寸法線の終点をマウスクリックした点に移動する }
{ 直線、寸法線以外の図形だと移動するので注意! }
var
__result__:boolean;
__h1, h2__:handle;
__x, y__:real;
begin
__h1:= FSActLayer;
__if h1 = nil then
____AlrtDialog('直線か寸法線を選択して下さい。')
__else begin
____Message('新しい終点をクリックして下さい。');
____GetPt(x, y);
____Locus(x, y);
____h2:= LNewObj;
____result:= SetBinaryConstraint(1, h1, h2, 2, -1, 1, -1, 0, 0);
____ResetObject(h1);
____DelObject(h2);
____ClrMessage;
__end;
end;
Run(test);


Re4:寸法線の編集    耕
Thu Aug 27 10:25:03 2009

与太郎様、返信ありがとうございます。
今のところグループが1階層までなので、グループがあれば解除して、寸法を作り直して
再度グループ化で進めています。
「拘束」は普段使っていなくて勉強不足でした。
とりあえず自分用なのでこのまま作ってみて、「拘束」も勉強してみたいと思います。
ありがとうございました。


Re3:寸法線の編集    与太郎
Tue Aug 25 15:58:16 2009

Get2DPtがあるんだから、
Set2DPtもあっていいのに、と思います。


Re2:寸法線の編集    与太郎
Tue Aug 25 15:53:29 2009

元のと同じ寸法線を作るのは大変だと思います。

まどろっこしいですが、
ダミーの基準点を作り、基準点に寸法線を拘束させて、
基準点を移動、寸法線をリセット、基準点を削除、
ではどうでしょうか。

バックナンバーのどこかに「拘束」を使った例があります。


Re:寸法線の編集    耕
Tue Aug 25 15:43:45 2009

石男様ありがとうございます。
やはりそうですか・・・
グループ内で変更出来ればと思ったのですが。
寸法線作り直すのでやってみようと思います。
ありがとうございました。


Re:寸法線の編集    石男
Tue Aug 25 15:27:22 2009

>寸法線の始点又は終点を変更
は不可能のようです。それらしいのが見当たりません。
変更がダメならもう一度寸法線を作るのが良いかもしれません。


寸法線の編集    耕
Tue Aug 25 13:56:48 2009

初めて書き込みさせていただきます。

2D編集ツール-範囲指定-移動で、グループ内の図形もまとめて変形出来るようなツールを考えていましす。
寸法線の始点または終点は、GetSegPt1又はGetSegPt2で取得出来るのに、
SetSegPt1又はSetSegPt2では変更出来ないんですね。
何か他の方法で、寸法線の始点又は終点を変更することは可能でしょうか?

よろしくお願い申し上げます。

環境:MacOS10.4.11 VectorWorks12.5


Re4:クイックソートって    与太郎
Sat Jul 4 6:40:29 2009

クイックソートの原理を簡単に言うと、
『全体を中間値より大きい部分と小さい部分に分割することを繰り返す』のですが、
何処まで繰り返すのでしょうか?
単純に考えると、それ以上は分割不可能な『1個まで』となりますが、
値の重複があるとそう簡単ではありません。下手をすると無限ループになります。
それで if (left <= lt) & (rt <= right) then として、
並べ替えが起きなかったらそれ以上はQSort2を呼び出さないようにしたのですが、
pivotの値が並べ替え範囲内の最小値だった場合、その範囲内はソートされないバグがありました。

下のスクリプトではpivotは配列の両端と中央の値を平均しているので、
両端の平均または中央だけの値を使うよりはいいだろうと思っていましたが、
同じ値が3個あればpivotが最小値になる可能性はゼロではないので無視はできません。
というわけで、pivotより大きい値の数をカウントしてnRtに入れ、
nRtがゼロでなければopt(option)をTRUEにしてやり直すようにしました。
opt=TRUEのときは、全部の値を合計して平均値を出しています。
全ケースでpivotに全体の平均を使うようにすれば処理をやり直すことはなくなるし、
スクリプトも少し簡単になるので、そのほうが早くなる可能性はあります。

{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right:longint; opt:boolean);
var
__i, j, lt, rt, nRt : longint;
__pivot { 境界値 } : real;
__temp : DM_item;
__
__{ 中間値を求める(opt=TRUEなら全ての値の平均) }
__function GetPivot(opt:boolean):real;
__var
____i : longint;
____sum : real;
__begin
____if opt then begin
______sum:= 0;
______for i:= left to right do
________sum:= sum + itemArray[i].itemID;
______GetPivot:= sum / (right - left + 1);
____end
____else
______GetPivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
__end;{GetPivot}

begin{QSort2}
__case (right - left) of
____0: begin end;
____1: begin
______if itemArray[right].itemID < itemArray[left].itemID then begin
________temp:= itemArray[right];
________itemArray[right]:= itemArray[left];
________itemArray[left]:= temp;
______end;
______DebugMessage(MaxDebug, left, right);
____end;
____otherwise begin
______pivot:= GetPivot(opt);
______lt:= left - 1;
______rt:= right + 1; nRt:= 0;
______for i:= left to right do begin
________if itemArray[i].itemID < pivot then begin
__________lt:= lt + 1;
__________tempArray[lt]:= itemArray[i];
________end{if}
________else begin
__________rt:= rt - 1;
__________tempArray[rt]:= itemArray[i];
__________if pivot < itemArray[i].itemID then
____________nRt:= nRt + 1;
________end;{else}
______end;{for}
______for i:= left to lt do
________itemArray[i]:= tempArray[i];
______j:= right;
______for i:= rt to right do begin
________itemArray[i]:= tempArray[j];
________j:= j - 1;
______end;
______DebugMessage(MaxDebug, left, right);
______if (left <= lt) & (rt <= right) then begin
________QSort2(left, lt, false);
________QSort2(rt, right, false);
______end
______else if 0 < nRt then
________QSort2(left, lt, true);
____end;{otherwise}
__end;{case}

たくさんのデータをソート出来るように配列をマイナスから始めると、
何故かpivotの計算で「配列の範囲外にアクセスした」とエラーが出ました。
調べると、leftもrightもゼロ以下なのに、(left + right) div 2 がプラスの値になっていました。
具体的には両端が-32768と-31744なら平均は-32256になるはずですが、実際には512でした。
これはleftとrightをinteger型にしていたのが原因です。

integer型整数は16ビットなので、-32768〜+32767の範囲しか表せません。
ゼロから1を足してゆくと、0、1、2、3・・・32765、32766、32767、-32768、-32767、-32766、と、
32767の次はいきなり-32768になります。
おかしな話ですが、コンピュータの整数はそういうもんなんです。
C言語などでは符号無しの16ビット整数もあって、範囲は0〜65535です。
この場合、0、1、2、3・・・65533、65534、65535、0、1、2・・・となります。
実はCPU自体は16ビット整数の-1と65535を区別してなくて、
ある整数が符号付きか符合無しかは、コンパイラやプログラマの解釈次第ということです。
まあ、VectorScriptには符号付き整数しかないので、その辺は考えなくていいですが。
整数の計算結果が範囲外になってもエラーが出ないのは、たいていはその必要ないからです。
ちゃんとしたコンパイラならエラーを出すオプションがありますが、処理速度が落ちるし、
たいていはチェックしない方が都合がいいのでデフォルトでオフになってます。

というわけで、integer型で (-32768 + -31744) div 2 を計算すると、
まず、-32768 + -31744 は -64512 となりますが、
-64512は16ビット整数の範囲外なので、1024と解釈されます。
1024 div 2 は 512 なので、
(-32768 + -31744) div 2 = 512 という結果になります。
その他いろいろ不都合があってめんどうなので、
配列を参照する変数は全てlongint型に直しました。


Re3:クイックソートって    石男
Thu Jul 2 23:32:02 2009

与太郎さん、最後までありがとうございました。
実はDialogMakerなるものを作っていたのですが、最後の最後に回避出来ないバグに遭遇し
まして、放置しております。公開出来ず残念です...。


Re2:クイックソートって、    与太郎
Thu Jul 2 10:14:57 2009

安定版クイックソートを修正しました。これで大丈夫だと思います。

PROCEDURE TestSort;
{ クイックソート(安定ソート) }
{ tempArrayでメモリを余分に使います }
{$ DEBUG}
CONST
__MaxArray = 20;
__MaxDebug = 20;
TYPE
__DM_item = STRUCTURE
____itemID : INTEGER;
____itemName : STRING;
__END ;
VAR
__itemArray, tempArray : ARRAY[1..MaxArray] OF DM_item;
__dataIndex : INTEGER ;

{////////////////////////////// AddData
配列をセット ////////////////////////////}
procedure AddData(id:integer; nm:string);
begin
__dataIndex:= dataIndex + 1;
__itemArray[dataIndex].itemID:= id;
__itemArray[dataIndex].itemName:= nm;
end;

{////////////////////////////// DebugMessage
デバッグメッセージ ////////////////////////////}
procedure DebugMessage(n, st, ed:integer);
var
__i : integer;
__s : string;
begin
__s:= Concat(st, '..', ed, ' ');
__for i:= 1 to n do begin
____s:= Concat(s, '__', itemArray[i].itemID, ':', itemArray[i].itemName);
__end;
__Message(s);
__WriteLn(s);
end;

{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right:integer);
var
__i, j, lt, rt : integer;
__pivot { 境界値 } : real;
__temp : DM_item;
begin
__case (right - left) of
____0: begin end;
____1: begin
______if itemArray[right].itemID < itemArray[left].itemID then begin
________temp:= itemArray[right];
________itemArray[right]:= itemArray[left];
________itemArray[left]:= temp;
______end;
______DebugMessage(MaxDebug, left, right);
____end;
____otherwise begin
______pivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
______lt:= left - 1;
______rt:= right + 1;
______for i:= left to right do begin
________if itemArray[i].itemID < pivot then begin
__________lt:= lt + 1;
__________tempArray[lt]:= itemArray[i];
________end{if}
________else begin
__________rt:= rt - 1;
__________tempArray[rt]:= itemArray[i];
________end;{else}
______end;{for}
______for i:= left to lt do
________itemArray[i]:= tempArray[i];
______j:= right;
______for i:= rt to right do begin
________itemArray[i]:= tempArray[j];
________j:= j - 1;
______end;
______DebugMessage(MaxDebug, left, right);
______if (left <= lt) & (rt <= right) then begin
________QSort2(left, lt);
________QSort2(rt, right);
______end;
____end;{otherwise}
__end;{case}
end;

{////////////////////////////// Main ////////////////////////////}
BEGIN
__dataIndex:= 0;
__AddData(5, 'mmm');
__AddData(5, 'nnn');
__AddData(5, 'ooo');
__AddData(2, 'ddd');
__AddData(2, 'eee');
__AddData(2, 'fff');
__AddData(7, 'sss');
__AddData(7, 'ttt');
__AddData(1, 'aaa');
__AddData(1, 'bbb');
__AddData(1, 'ccc');
__AddData(4, 'jjj');
__AddData(4, 'kkk');
__AddData(4, 'lll');
__AddData(3, 'ggg');
__AddData(3, 'hhh');
__AddData(3, 'iii');
__AddData(6, 'ppp');
__AddData(6, 'qqq');
__AddData(6, 'rrr');
__
__DebugMessage(MaxDebug, 1, MaxDebug);__QSort2(1, MaxDebug);
__AlrtDialog('結果は Output File(Output.txt) に書き出しました。');
END;
RUN(TestSort);


Re:クイックソートって、    与太郎
Fri Jun 26 20:28:26 2009

元々はprocedure QSort2の上にprocedure QSortがあったのでエラーが出なかったんです。
ここに貼付ける前にいらない行を消しました。確認するまでもないと思ったら、大間違いでした。
要するに、最初以降はQSortを呼んでいたんですね。こりゃあいくら修正しても直らないはずだ。


バグって    石男
Fri Jun 26 17:58:59 2009

ホント困ります。他の方法で回避できればいいんですが、できないものもありますしね。
ちなみに与太郎さん
>QSort(left, lt);
>QSort(rt, right);
違っています(笑)問題はこれじゃないですけど。


クイックソートって、    与太郎
Fri Jun 26 13:44:56 2009

アイデアが出てからバグのないバージョンの完成まで20年くらいかかったと、
何かで読んだ記憶があります。こんなに短いのになんで?って感じですが。
もちろんPASCALもデバッガもない頃の話です。
配列内で要素を移動してるうちにわけがわからなくなるからでしょうか。
そこで元の配列の他にもう1つ配列を使うと、左右への振り分けが判りやすくなります。
また、クイックソートは不安定ソートですが、2つの配列を使えば簡単に安定させられるはずです。

PROCEDURE TestSort ;
{$ DEBUG}
CONST
__MaxArray = 20;
__MaxDebug = 20;
TYPE
__DM_item = STRUCTURE
____itemID : INTEGER ;
____itemName : STRING ;
__END ;
VAR
__itemArray, tempArray : ARRAY[1..MaxArray] OF DM_item ;
__dataIndex : INTEGER ;

{////////////////////////////// AddData
配列をセット ////////////////////////////}
procedure AddData(id:integer; nm:string);
begin
__dataIndex:= dataIndex + 1;
__itemArray[dataIndex].itemID:= id;
__itemArray[dataIndex].itemName:= nm;
end;

{////////////////////////////// DebugMessage
デバッグメッセージ ////////////////////////////}
procedure DebugMessage(n:integer);
var
__i : integer;
__s : string;
begin
__for i:= 1 to n do begin
____s:= Concat(s, '__', itemArray[i].itemID, ':', itemArray[i].itemName);
__end;
__Message(s);
__WriteLn(s);
end;

{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right : INTEGER);
var
__i, j, lt, rt : INTEGER;
__pivot { 境界値 } : REAL;
__temp : DM_item;
begin
__case (right - left) of
____0: begin end;
____1: begin
______if itemArray[right] < itemArray[left] then begin
________temp:= itemArray[right];
________itemArray[right]:= itemArray[left];
________itemArray[left]:= temp;
________DebugMessage(MaxDebug);
______end;
____end;
____otherwise begin
______pivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
______lt:= left - 1;
______rt:= right + 1;
______for i:= left to right do begin
________if itemArray[i].itemID < pivot then begin
__________lt:= lt + 1;
__________tempArray[lt]:= itemArray[i];
________end{if}
________else begin
__________rt:= rt - 1;
__________tempArray[rt]:= itemArray[i];
________end;{else}
______end;{for}
______for i:= left to lt do
________itemArray[i]:= tempArray[i];
______j:= right;
______for i:= rt to right do begin
________itemArray[i]:= tempArray[j];
________j:= j - 1;
______end;
______DebugMessage(MaxDebug);
______QSort(left, lt);
______QSort(rt, right);
____end;{otherwise}
__end;{case}
end;

{////////////////////////////// Main ////////////////////////////}
BEGIN
__dataIndex:= 0;
__AddData(5, 'mmm');
__AddData(5, 'nnn');
__AddData(5, 'ooo');
__AddData(2, 'ddd');
__AddData(2, 'eee');
__AddData(2, 'fff');
__AddData(7, 'sss');
__AddData(7, 'ttt');
__AddData(1, 'aaa');
__AddData(1, 'bbb');
__AddData(1, 'ccc');
__AddData(4, 'jjj');
__AddData(4, 'kkk');
__AddData(4, 'lll');
__AddData(3, 'ggg');
__AddData(3, 'hhh');
__AddData(3, 'iii');
__AddData(6, 'ppp');
__AddData(6, 'qqq');
__AddData(6, 'rrr');
__DebugMessage(MaxDebug);
__
__QSort2(1, MaxDebug);
__AlrtDialog('結果は Output File(Output.txt) に書き出しました。');
END;
RUN(TestSort);

で、安定ソートなら上のデータがabc順に並び替えられるはずですが、そうなりません。
悩ましいです。


RE4:クイックソート&選択ソート    石男
Wed Jun 24 10:17:06 2009

あまりの要素の多さに...。なるほど、今回は非常に助かりました、masafumiさん。
最後の壁を乗り越えれば完成なんですが...。


RE3:クイックソート&選択ソート      masafumi
Tue Jun 23 23:06:27 2009

どうも、masafumi です。要素数だけソートすると大変だなぁ・・・。と思い、ちょっとチェックしてみました。(^^;)

var
temp2:DM_item;
begin
・・・・・・・
  ・・・・・・
temp := itemArray[ ii ].itemID ;
temp2:=itemArray[ii];
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ ii ]:=itemArray[ jj ];
itemArray[ jj ].itemID := temp ;
itemArray[ jj ]:=temp2;
・・・・・・・
  ・・・・・・
end;


これで要素数に関係なく行けそうです。お騒がせ致しました。


RE2:クイックソート&選択ソート    石男
Tue Jun 23 21:43:59 2009

どうもmasafumiさん!
なるほど、構造体の要素分だけtempが必要になるんですね。実際はもっと多いので出来る
だけ要素をへらした方がいいかな。


RE1:クイックソート&選択ソート   masafumi
Tue Jun 23 19:37:51 2009

こんばんは、masafumi です。

itemID と同時に itemName も変更する必要が有ります。

下記は変数に temp2 を追加して temp2 に itemName を保存しています。
SSort()は必要ないと思います。

{////////////////////////////// QSort itemID でソート ////////////////////////////}
PROCEDURE QSort( left, right : INTEGER ) ;
VAR
ii, jj : INTEGER ;
pivot { 境界値 } : REAL ;
temp : INTEGER ;
temp2: STRING;
BEGIN
IF left < right THEN BEGIN
pivot := ( itemArray[ left ].itemID+itemArray[ right ].itemID )/2 ;
ii := left ;
jj := right ;
REPEAT
WHILE itemArray[ ii ].itemID < pivot DO
ii := ii+1 ;
WHILE itemArray[ jj ].itemID > pivot DO
jj := jj-1 ;
IF ii <= jj THEN
BEGIN
temp := itemArray[ ii ].itemID ;
temp2:= itemArray[ii].itemName;
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ ii ].itemName := itemArray[ jj ].itemName ;
itemArray[ jj ].itemID := temp ;
itemArray[ jj ].itemName := temp2 ;
ii := ii+1 ;
jj := jj-1 ;
END ;{ End of if }
UNTIL ii > jj ;
QSort( left , jj ) ;
QSort( ii, right ) ;
END ;{ End of if }
END ;


クイックソート&選択ソート    石男
Mon Jun 22 15:02:00 2009

構造体を使った配列でソートを行うと間違った結果になります。どこがおかしいのか分か
りません。30〜40ぐらいの配列の大きさを想定していますので、特にスピードは要求しま
せん。

PROCEDURE TestSort ;

TYPE
DM_item = STRUCTURE
itemID : INTEGER ;
itemName : STRING ;
END ;
VAR
itemArray : ARRAY[ 1..5 ] OF DM_item ;

{////////////////////////////// QSort
itemID でソート ////////////////////////////}
PROCEDURE QSort( left, right : INTEGER ) ;
VAR
ii, jj : INTEGER ;
pivot { 境界値 } : REAL ;
temp : INTEGER ;
BEGIN
IF left < right THEN BEGIN
pivot := ( itemArray[ left ].itemID+itemArray[ right ].itemID )/2 ;
ii := left ;
jj := right ;
REPEAT
WHILE itemArray[ ii ].itemID < pivot DO
ii := ii+1 ;
WHILE itemArray[ jj ].itemID > pivot DO
jj := jj-1 ;
IF ii <= jj THEN BEGIN
temp := itemArray[ ii ].itemID ;
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ jj ].itemID := temp ;
ii := ii+1 ;
jj := jj-1 ;
END ;{ End of if }
UNTIL ii > jj ;
QSort( left , jj ) ;
QSort( ii, right ) ;
END ;{ End of if }
END ;


{////////////////////////////// SSort
itemID でソート ////////////////////////////}
PROCEDURE SSort( Max_int : INTEGER ) ;
VAR
ii , jj ,w : INTEGER ;
BEGIN
ii := 0 ;
jj := ii+1 ;
WHILE ii < Max_int-1 DO BEGIN
ii := ii+1 ;
WHILE jj < Max_int DO BEGIN
jj := jj+1 ;
IF itemArray[ jj ].itemID < itemArray[ ii ].itemID THEN BEGIN
w := itemArray[ jj ].itemID ;
itemArray[ jj ].itemID := itemArray[ ii ].itemID ;
itemArray[ ii ].itemID := w ;
END ;
END ;
END ;
END ;


{////////////////////////////// Main ////////////////////////////}
BEGIN

itemArray[ 1 ].itemID := 5 ; itemArray[ 1 ].itemName := 'bbb' ;
itemArray[ 2 ].itemID := 4 ; itemArray[ 2 ].itemName := 'aaa' ;
itemArray[ 3 ].itemID := 6 ; itemArray[ 3 ].itemName := 'ccc' ;
itemArray[ 4 ].itemID := 8 ; itemArray[ 4 ].itemName := 'eee' ;
itemArray[ 5 ].itemID := 7 ; itemArray[ 5 ].itemName := 'ddd' ;

QSort( 1, 5 ) ;

SSort( 5 ) ;
AlrtDialog( Concat( itemArray[ 1 ].itemID , '=' , itemArray[ 1 ].itemName , ' ' ,itemArray[ 2 ].itemID , '=', itemArray[ 2 ].itemName ) ) ;

END ;

RUN( TestSort ) ;


Re2:SDKサブルーチンライブラリとは?    与太郎
Sun Jun 21 9:09:31 2009

石男さん、サイトの紹介ありがとうございます。

対応バージョンが書いてあるのがちょっと嬉しい。


Re:SDKサブルーチンライブラリとは?    石男
Sat Jun 20 11:01:27 2009

SDKサブルーチンライブラリの丁寧な解説ありがとうございました。
File関係など使えそうなのもあります。ちなみに「HiBase」はなくなっております。
その代わりxmlが使えます。複雑な構造にしなければ充分にいけます。
SDKサブルーチンライブラリについて少ない情報ですが以下のサイトで取れます。ここに
なければ後は自力で...
http://charles-chandler.org/

>実行時の単位で-1ですか?
違うようです。-1mmなのかな微妙です。


SDKサブルーチンライブラリとは?    与太郎
Fri Jun 19 10:50:18 2009

SDKサブルーチンライブラリとは、VectorWorks plug-in libraryのことです。
VectorScriptプラグインのxxx.vssやxxx.xxtに相当します。
CPUで直接実行するバイナリ形式なので、VectorScriptより格段に高速です。
そのかわり開発にはC++コンパイラとSDK(Software Deveropment Kit)が必要です。
SDKで作るからSDKサブルーチンライブラリと呼んでいます。

SDKサブルーチンライブラリがPlug-insフォルダにあると、VWは起動時にサブルーチンを読み込みます。
それらのサブルーチンは、標準組込みサブルーチン(VSリファレンスに載ってるやつ)と同じように、
VectorScriptで使用できます。
読み込み時に「VWPluginLibraryRoutines.p」と「VWPluginLibraryRoutines.h」にヘッダが書き出されま す。
ですから「VWPluginLibraryRoutines.p」を見れば、どんなサブルーチンが追加されているか判ります。
だだし、パラメータや実行結果の説明はありません。
NNAやAAAが注力している「イベント」や「HiBase」については多少は情報がありますが、
開発者自身の使用しか想定していないものは当然何の説明もないので、
常識で判断するか、自分で動作確認することになります。
つまり「使用は自己責任で」ということです。


>変換された多角形はy方向に-1だけズレて出来ます。
えっ、そういう仕様なんですか?
実行時の単位で-1ですか?


TrueTypeを多角形に変換    石男
Thu Jun 18 16:30:26 2009

では、SDKサブルーチンライブラリよりもうひとつ!DoMenuで「TrueTypeを多角形に変換」
を使うとうまく制御できなかったりしたものです。そこで...

PROCEDURE xxxx ;
VAR
txtH , polyH : HANDLE ;
something : LONGINT ;
boo : BOOLEAN ;
BEGIN
MoveTo( 0 , 0 ) ;
CreateText( 'TrueTypeToPoly' ) ;
txtH := LNewObj ;
something := TrueTypeToPoly( txtH, polyH ) ;
boo := SetParent( polyH, GetParent ( txtH ) );
END ;
RUN( xxxx ) ;
これで完全に制御できます。変換された多角形はy方向に-1だけズレて出来ます。


Re2:PickObjectよりも    石男
Thu Jun 18 16:19:07 2009

全て与太郎殿のご説明の通りでございます。
>「最上位」の図形は最前面ではなく最背面にある
よくある話です、まあ説明なしよりはいいのですが...。ターゲット図形のハンドルを取る
ためのサブルーチンをつくるのが面倒なので、ご指摘の通りSDKサブルーチンライブラリか
ら関数を探しました(笑)
>FindObjAtPt_CreateとFindObjAtPt_GetCount
まあこんな便利な物は表に出してもらいたいものです。


Re:PickObjectよりも    通りすがりの与太郎
Thu Jun 18 9:49:50 2009

説明しよう!、(富山敬風に)

>PickObjectを使うと任意の座標点の下にある最上位の図形のハンドルが返ります。

VSリファレンスで言うところの「最上位」とは、見た目で一番上(前面)の図形のことではない。
図形ハンドルリストの最初の図形ということである。「最上位」はFirstの誤訳と思われる。
したがって、マニュアルの「最上位」は「最初」と読み替えることが必要だ。
図形は描いた順にリストにリンクされるので、「最上位」の図形は最前面ではなく最背面にある。
通常、VSサブルーチンはリストの最初から図形を検索するので、
多くのサブルーチンが戻り値として「最上位」の図形ハンドルを返す。

座標の下に複数の図形があった場合にPickObjectでどの図形のハンドルが返ってくるかは、
下のスクリプトで試していただきたい。

procedure test;
var
x, y :real;
h :handle;
begin
DSelectAll;
Message('選択したい図形をクリックしてください');
GetPt(x, y);
h:= PickObject(x, y);
SetSelect(h);
ClrMessage;
end;
Run(test);

お分かりのように、選択されるのは最前面の図形である。
これは選択ツールと同じ動作なので、使う方も混乱する心配が無い。
つまり通常とは反対に、PickObjectの内部ではリンクの最後から図形を検索しているのである。
と言うわけで、フッフッフッ石男殿!
「PickObjectでは任意の座標点の下にある最後(最前面)の図形のハンドルが返る」のでござる!
ご油断召されましたな。しかも...
拙者の見たところFindObjAtPt_CreateとFindObjAtPt_GetCountはVSリファレンスに載っておらぬ。
つまりこれはSDKサブルーチンライブラリで追加された関数である。
ここのところの説明が、ちと足りぬようじゃが、いかがかの石男殿?


PickObjectよりも    石男
Wed Jun 17 12:48:55 2009

PickObjectを使うと任意の座標点の下にある最上位の図形のハンドルが返ります。座標の
下に複数の図形があった場合どうするの?という疑問が湧いてきまして、自力で考えられ
ず探したら出てきました。2009では動作確認済み、それ以外は分かりません。
PROCEDURE xxxxx;
VAR
cnt, i : INTEGER;
startContainer : HANDLE;
list : LONGINT;
loc: VECTOR;

BEGIN
GetPt(loc.x, loc.y);
startContainer := NIL;

list := FindObjAtPt_Create(startContainer, 1, 0, loc.x, loc.y, 1);
cnt := FindObjAtPt_GetCount(list);

i := 0;
WHILE i < cnt DO BEGIN
AlrtDialog(Concat('Index: ', i, ' Obj Type: ', GetType(FindObjAtPt_GetObj(list, i))));
i := i + 1;
END;
END;
Run(xxxxx);


イベントサンプルについて    石男
Sun May 24 13:05:09 2009

オブジェクト(プラグインオブジェクト)は通常、「回転、移動で実行」というタイミン
グでスクリプトが動きますが、「指定されたイベントで実行」という選択肢があります。
データパレットの中にプッシュボタンがついているのをイメージしてもらえば、分ると
思います。このボタンを付けるためのサンプルです。
オブジェクトにも種類があり、それによってやり方が変わりますが、基本の部分は同じ
です。情報源は全て英語ですし、基本的にサポートなしの世界なので気合いがある人のみ
勧めます。


オブジェクトのイベントサンプル    石男
Fri May 22 18:17:24 2009

備忘録的にサンプルをアップします。「プロパティ」ー「指定されたイベントで実行」に
チェックをいれてお使いください。この辺りはサポートなしですので、苦情は困ります。
オブジェクトにボタンをつけて、そのボタンをクリックすると基本的にオブジェクトの外
に飛び出します。オブジェクトそのものを更新したい時はGetCustomObjectInfoなどで自分自身を呼び出す必要があります。
{Object that has a button on the Object Info palette: }
PROCEDURE Example ;
CONST
kObjOnInitXProperties = 5;
kResetEventID = 3;
kObjXPropHasUIOverride = 8;
kWidgetButton = 12;
kObjOnObjectUIButtonHit = 35;

VAR
theEvent, theButton :LONGINT;
result :BOOLEAN;
buttonEventID :INTEGER;
thisDoesNothing :LONGINT;
glovalHd ,objHand , recHand , wallHand : HANDLE ;
objName : STRING ;
x , y , obj_ang : REAL ;
{///////////////Dialog Variable///////////////}

lEditID : LONGINT ;
co_index : INTEGER ;
fill_color , pen_color : RGBCOLOR ;

{////////////////////////////////dialog_Setup///////////////////////////////}
FUNCTION dialog_Setup : BOOLEAN ;
BEGIN
lEditID := CreateLayout( 'Color Control' , true , 'OK' , 'Cancel' ) ;


CreateStaticText(lEditID, 4 , '線の色:' , 12 ) ;
CreateColorPopup(lEditID, 5 , 24 ) ;
CreateStaticText(lEditID, 6 , '面の色:' , 12 ) ;
CreateColorPopup(lEditID, 7 , 24 ) ;

SetFirstLayoutItem(lEditID, 4 ) ;
SetRightItem( lEditID, 4 , 5 , 0 , 0 ) ;
SetBelowItem( lEditID, 4 , 6 , 0 , 0 ) ;
SetRightItem( lEditID, 6 , 7 , 0 , 0 ) ;

dialog_Setup := VerifyLayout( lEditID ) ;
END ;

{///////////////////////////////dialog_Handler////////////////////////////////}
PROCEDURE dialog_Handler( VAR item : LONGINT ; data : LONGINT ) ;
BEGIN
CASE item OF
{ dialog initialization }
SetupDialogC:
BEGIN

END ;
{ user selected OK }
1:
BEGIN
GetColorChoice( lEditID, 5 , co_index ) ;
ColorIndexToRGB( co_index , pen_color.red , pen_color.green , pen_color.blue ) ;
GetColorChoice( lEditID, 7 , co_index ) ;
ColorIndexToRGB( co_index , fill_color.red , fill_color.green , fill_color.blue ) ;
END ;
END ;{ End of CASE item }
END ;

{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
vsoGetEventInfo(theEvent, theButton);
CASE theEvent OF

{User has single-clicked the object's icon.}
kObjOnInitXProperties:
BEGIN
{ Buttonを付ける時の決まり事 vsoAppendWidgetとセットで }
result := SetObjPropVS(kObjXPropHasUIOverride, TRUE);

{Now we manually add the "normal" parameters...}

{One way is to use this single call to add all
of the existing parameters.}
result := vsoInsertAllParams;

{Finally, we add the button. 3番目の引数は関係なし }
result := vsoAppendWidget(kWidgetButton, 10 , '新規作成...', thisDoesNothing);
result := vsoAppendWidget(kWidgetButton, 11 , '変更...', thisDoesNothing);
END;

{User has clicked a button in the Object Info palette.}
kObjOnObjectUIButtonHit:
BEGIN
CASE theButton OF
10:
BEGIN
IF dialog_Setup THEN BEGIN
{ RunLayoutDialog 1=ok 2=cancel }
IF RunLayoutDialog( lEditID , dialog_Handler ) = 1 THEN BEGIN
Rect(0, 0, 10, 10);
glovalHd := LNewObj ;
SetFillBack( glovalHd , fill_color.red , fill_color.green , fill_color.blue ) ;
SetPenFore( glovalHd , pen_color.red , pen_color.green , pen_color.blue ) ;
END ;
END ;{ End of dialog_Setup }
END;
11:
BEGIN
IF dialog_Setup THEN BEGIN
{ RunLayoutDialog 1=ok 2=cancel }
IF RunLayoutDialog( lEditID , dialog_Handler ) = 1 THEN BEGIN
IF GetCustomObjectInfo( objName , objHand , recHand , wallHand ) THEN BEGIN
SetFillBack( objHand , fill_color.red , fill_color.green , fill_color.blue ) ;
SetPenFore( objHand , pen_color.red , pen_color.green , pen_color.blue ) ;
ResetObject( objHand ) ;
END ;
END ;
END ;{ End of dialog_Setup }
END ;
END;
END;

{Object内の図形はここで書く}
kResetEventID:
BEGIN
Rect(0, 0, 10, 10);
END;

END;
END;
Run(Example);


Re^5:建築申請V12を2009で使えるようにするには    与太郎
Thu Apr 2 21:36:16 2009

>江戸の黒板当番さま
作業画面の設計で、カテゴリが「AA建築申請」のメニューコマンドとツールを
新しいメニュー「建築申請」とツールセット「建築申請」に登録しました。
1回目は「○○○+建築申請」の名前で保存に失敗したので、
2回目は名前をそのままにしたら保存出来ました。
でも、最初に失敗したのがたまたまか名前のせいかは判りません。


Re^4:建築申請V12を2009で使えるようにするには   
Thu Apr 2 10:34:58 2009

与太郎さま
お世話になっています。

>12.5用の作業画面を読み込めなかったのでメニューとツールの登録が必要でしたが、
>一見問題なく動いているようです。

動いているんですか。作業画面が読み込めない時点でつまずいていますんで
メニューとツールの登録についても教えていただけませんか?
マニュアルを超えた話の様な......


ファイルの一括変換(MacOSXにて)    与太郎
Wed Apr 1 18:40:05 2009

50程度のファイルなら、スクリプトを書いて動作を確認する間に、
手作業で変換が終わってしまうと思います。

ただ、物件ごとに50件だとやはり面倒なので、
MacOSXのAppleScriptで自動変換する方法を書いてみます。

複数ファイルを対象とするにはAppleScriptをアプレットにします。
ファイルをドラッグ&ドロップでアプレットに落とせば、スクリプトを実行できます。

個々のファイルの処理は、
  ファイルを開く、
  ファイル書き出すメニューコマンドを実行、
  ファイル保存ダイアログが開くまで待つ、
  「OK」ボタンを押す(または「Enter」キーを押す)、
  書き出しが終わるまで待つ、
  ファイルを閉じる、
  保存警告ダイアログが出たら「いいえ」ボタンを押す(または「Command」+「d」を押す)
のようになります。

スクリプトを簡単にするために、
VectorWorksはあらかじめ起動しておきます。
また、書き出しコマンドには「Command」+「Option」+「s」を割り当てます。
ファイルを閉じるときに保存警告ダイアログが出たり出なかったりすると面倒なので、
DoScript" "で適当なVectorScriptを実行して、必ずダイアログが出るようにします。

AppleScriptでは「System Events」経由でキーの打ちこみが可能なので、
適当なタイミングでキーを打つ方法でスクリプトは書けます。

on open | selectFiles |
__tell application "Finder"
____repeat with | currFile | in | selectFiles |
______set | filePath | to (| currFile | as string)
______if folder | filePath | exists then
______else
________open | currFile |
________delay 3
________tell application "VectorWorks11.5"
__________DoScript " Message('変換中...'); "
________end tell
________tell application "System Events"
__________tell process "VectorWorks11.5"
____________keystroke "s" using {command down, option down}
____________delay 1
____________keystroke return
____________delay 3
__________end tell
________end tell
________tell application "VectorWorks11.5"
__________activate
__________DoScript " ClrMessage; "
________end tell
________tell application "System Events"
__________tell process "VectorWorks11.5"
____________keystroke "w" using {command down}
____________delay 1
____________keystroke "d" using {command down}
__________end tell
________end tell
________delay 2
______end if
____end repeat
__end tell
end open

アプリの名前を変えている場合は、その名前でないとアプリの切り替えが出来ません。
所々にdelayがあるのは、VWの動作(ダイアログを開く等)とのタイミングを取るためです。
Delayが短かすぎるとAppleScriptがVWを追い越してしまって、ファイルを書き出せなかったり
ファイルが閉じなかったりするので、Macの性能が違うと調整が必要です。

AppleScriptではOSXアプリの全てのUI要素にアクセス出来ます。
UI要素とは、ウィンドウ、パレット、ボタン、メニューなど、ドキュメントウインドウの中身
以外の部分です。
「UIElementInspector」や「UI Browser」でUI要素の名前を調べれば、特定のボタンを押したり、
ダイアログが開いているかを判断して実行するスクリプトも書けます。
「UI Browser」ではAppleScriptの自動生成してくれるようです。


Re^3:建築申請V12を2009で使えるようにするには    与太郎
Wed Apr 1 8:42:15 2009

2009で建築申請を試してみました。
12.5用の作業画面を読み込めなかったのでメニューとツールの登録が必要でしたが、
一見問題なく動いているようです。


Re^2:建築申請V12を2009で使えるようにするには    江戸の黒板当番
Wed Mar 18 12:02:35 2009

与太郎さま早速ありがとうございます。
基本的な機能拡張用のスクリプトの変更の仕方だと思うのですよ。

ソースがオープンになることで突然、自己責任でといわれても
途方に暮れてしまいますよね。

2009のデモ版でもちょっとお試しくださいませ。


Re:建築申請V12を2009で使えるようにするには    与太郎
Mon Mar 16 22:22:06 2009

2009は手元にないので2008(デモ版)に入れてちょこっと見ただけですが、
「建築申請書類作成...」で文字化けする症状なら、
とりあえずSetTextFontの行をコメントアウトしたら日本語になりました。


建築申請V12を2009で使えるようにするには    江戸の黒板当番
Thu Mar 12 21:59:01 2009

確認申請の申請書も1Fileにしておくためには外せないPluginなんですが
Workspacesがだめなのかな、上手く動きません。
http://www.aanda.co.jp/VIPRoom/vsot/downloadextra.htm
ここのです。

http://www.aanda.co.jp/VIPRoom/vsot/index.htm
でソースがオープンになっているのですがアップデートに
ご協力というより使えるようにしていただける方募集です。

まあ、どれから始めたら良いものかなど教えて下さい。


Re:プラグインオブジェクトの文字設定    与太郎
Tue Jan 27 21:08:45 2009

タニさん、こんばんは。

データパレットにボタンを付ける方法は、VectorScript談話室2004(バックナンバー)の
石男さんのレス「イベント実行」のサンプルで判ると思います。


プラグインオブジェクトの文字設定    タニ
Tue Jan 27 18:50:12 2009

>与太郎様

早速のご指導ありがとうございます。

ご指摘頂いた「特定イベント」でカスタムダイアログを開く方法ですが、
正多角形ツールのデータパレットにある「頂点を追加」のようなボタンを押して
ダイアログが開くように設定することは可能でしょうか。

パラメータを設定する際の「型」の選択項目にボタンの項目がないので、
何か他の方法で設定が可能なのでしょうか。

以上、ご指導をお願いいたします。


プラグインオブジェクトの文字(フォント)設定    与太郎
Mon Jan 26 8:46:50 2009

FUNCTION GetCustomObjectChoice(objectName:STRING; parameterName:STRING; choiceIndex:INTEGER):STRING;
で、ポップアップパラメータのアイテムを調べることは出来ますが、
ポップアップパラメータのアイテムを書き換えるサブルーチンはありません。
プラグインオブジェクトのフォントを変えるには、
「特定イベント」でカスタムダイアログを開いて、ダイアログ内のポップアップメニュー
からフォントを選ぶか、
GetObjectVariableBoolean(h, 800, TRUE); でプラグインオブジェクトのフォントを
フォントメニューから変更出来るように指定してください。


プラグインオブジェクトの文字設定    タニ
Fri Jan 23 16:26:41 2009

現在、プラグインオブジェクトを作成しており、
プラグインオブジェクトに表示される文字のフォントを変更可能にしたいと思っています。

方法としてはパラメータのPop-upリストにフォントリストを表示させ、
そこから選択できるようにしたいのですが、scriptの組み方が分かりません。
イメージは文字ツールで文字を作成した時にデータパレットに表示されるフォントリストです。

・GetFontName(fontID:INTEGER);で取得したフォント名を
パラメータに表示させる方法が考えられますが、scriptが分かりません。

分かる方、ご指導をお願いいたします。


年末年始のご挨拶は    管理人
Wed Dec 31 16:29:33 2008

喫茶室に書き込んで下さい。


バックナンバーに    管理人
Wed Dec 31 16:29:06 2008

移動しました。