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

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

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 は使ったことがないですが、パラメータを１個使えば、プラグイン・オブジェクト（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談話室では管理人さんが３桁のレスを目標に話題を振ってます。こちらではこのお題で何レスまで引っ張れるでしょうかね。

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）でも石男さんと同様の状態ですね。初めてツールをクリックした時は普通にインクリメントされますが、ツールの選択を解除後に再びツールをクリックした時は、最初の数字が＋３され、その後はまた普通にインクリメントされます。 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がインクリメントされますが、オブジェクト生成時にはインクリメントされる前の値に戻っています。結果的には正しいのですが... ２点型ではツールをクリックしただけではスクリプトは実行されません。

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)だと１からでも、途中で番号を変えてもちゃんとインクリメントされました。デバッグ・モードで、何回実行されてるか確かめるしかないですね。

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)_)_; ____{下の２行を追加。パラメータの初期値を変える} ____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のも見られるので新し物好きな方にはお勧めです。

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

ブラウザによっては、×と□の文字幅が違うんですね。下の絵で、龗は四角形が侵してはいけない領域です。幅は１mです。囗の部分から四角形は出てはいけません。この部分は７m×７mです。この中であれば、６m×６mの四角形をどこに描いても、隣の四角形との間隔は１～３mに収まります。囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗龗囗囗囗囗囗囗囗囗の領域内の中心に描かれた６m×６mの四角形は、上下左右に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

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

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

初心者さん、はじめまして。とりあえず、下のように１ｍ間隔で７ｍ×７ｍの領域を設定して、その範囲から出ないようにランダムに四角形を描けば、間隔を１ｍ～３ｍに出来ます。 □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ ××××××××××××××××××××××××××××××××××××××× □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ ××××××××××××××××××××××××××××××××××××××× □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ □□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□×□□□□□□□ 下のように領域をずらして設定したほうが、よりランダムに見えます。 ×□□□××××××□□□×□□□×□□□ ×□□□×□□□××××××□□□×□□□ ×□□□×□□□×□□□××××××□□□ ×××××□□□×□□□×□□□××××× □□□××××××□□□×□□□×□□□× □□□×□□□××××××□□□×□□□× □□□×□□□×□□□××××××□□□× ××××□□□×□□□×□□□×××××× □□××××××□□□×□□□×□□□×× □□×□□□××××××□□□×□□□×□ □□×□□□×□□□××××××□□□×□ ×××□□□×□□□×□□□××××××□ □××××××□□□×□□□×□□□××× □×□□□××××××□□□×□□□×□□ □×□□□×□□□××××××□□□×□□ ××□□□×□□□×□□□××××××□□ ××××××□□□×□□□×□□□××××

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

はじめまして　VectorScript初心者のものです。みなさんに質問したいのですが、６ｍ角の四角形をある範囲のなかにランダムにちりばめたいんですがどうしたらいいですか？　また付加条件として四角形同士の隣り合う間隔を１ｍ～３ｍぐらいにしたいんですけどどうしたらいいですか？もしよければ助けてください。お願します。

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:２つの３Ｄ基準点でビューを設定する　　与太郎 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

＞下の手はかなり良いものだと思いますよ。石男さん、ありがとうございます。正直、自分でもそう思いました（自画自賛）。視点側の３Ｄ基準点を選択するコマンドと併用すると便利です。視点の座標をデータパレットで変えながらアングルを調整出来ます。壁の座標ですが、寸法線と同様に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に相当するものがありませんどうしたら良いのか、お願いします。

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

手動でもスクリプトでも、オブジェクトを「見る角度」を設定するのは難しいです。思いどおりに設定するのは無理じゃないかと思ってましたが、５年前くらいにSetViewVectorについての書き込みがあったのを、今日思い出しました。これなら対象物と視点の座標から「見る角度」を設定出来ます。 procedure SetViewByPoints; { ２つの３Ｄ基準点でビューを設定する } 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, '"という名前の３Ｄ基準点がありません！')); ＿＿＿＿GoTo 999; ＿＿end; ＿＿hT:= GetObject(Target); ＿＿if (hT = nil) | (GetType(hT) <> Loc3DObj) then begin ＿＿＿＿AlrtDialog(Concat('"', Target, '"という名前の３Ｄ基準点がありません！')); ＿＿＿＿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」という名前の３Ｄ基準点を、視点位置には「Camera Position」という名前の３Ｄ基準点を作って、スクリプトを実行してください。実行後は画面が透視投影になります。

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の４番目のパラメータを１にすれば、始点の変更になります。 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

クイックソートの原理を簡単に言うと、『全体を中間値より大きい部分と小さい部分に分割することを繰り返す』のですが、何処まで繰り返すのでしょうか？単純に考えると、それ以上は分割不可能な『１個まで』となりますが、値の重複があるとそう簡単ではありません。下手をすると無限ループになります。それで if (left <= lt) & (rt <= right) then として、並べ替えが起きなかったらそれ以上はQSort2を呼び出さないようにしたのですが、 pivotの値が並べ替え範囲内の最小値だった場合、その範囲内はソートされないバグがありました。下のスクリプトではpivotは配列の両端と中央の値を平均しているので、両端の平均または中央だけの値を使うよりはいいだろうと思っていましたが、同じ値が３個あれば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の範囲しか表せません。ゼロから１を足してゆくと、0、1、2、3・・・32765、32766、32767、-32768、-32767、-32766、と、 32767の次はいきなり-32768になります。おかしな話ですが、コンピュータの整数はそういうもんなんです。Ｃ言語などでは符号無しの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もデバッガもない頃の話です。配列内で要素を移動してるうちにわけがわからなくなるからでしょうか。そこで元の配列の他にもう１つ配列を使うと、左右への振り分けが判りやすくなります。また、クイックソートは不安定ソートですが、２つの配列を使えば簡単に安定させられるはずです。 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建築申請」のメニューコマンドとツールを新しいメニュー「建築申請」とツールセット「建築申請」に登録しました。１回目は「○○○+建築申請」の名前で保存に失敗したので、２回目は名前をそのままにしたら保存出来ました。でも、最初に失敗したのがたまたまか名前のせいかは判りません。

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

移動しました。