* 画面のキャプチャ [#e086f929]
-ページ: [[スクリプト関連]]
-投稿者: [[sugi]]
-優先順位: 低
-状態: 完了
-投稿日: 2005-09-18 23:28:12 (日)
** メッセージ [#e11be76f]
皆さん、こん＊＊は。
画面のキャプチャをとるスクリプトを作成しています。
浮動ツールバーがじゃまになるので、ツールバーを一時的に隠すようにしてみ
たのですが、うまく動作しません。ツールバーの再表示の部分をコメントアウ
トすると、スクリプト終了時にツールバーが消えるので、スクリプト自体は間
違ってないと思うのですが、こういうものなのでしょうか？
なにか良い方法はないでしょうか？
また、配列を追加する方法がよく分からなかったので、j なんて使っているの
ですが、多分もっと簡単な方法があるように思います。こちらも、教えてくだ
さい。
vbs なんてあまり使ったことがないので、オンラインヘルプやらリファレンス
ブックやらを見ながら悪戦苦闘中です。簡単なことをどう書いて良いやら分か
らないというのは、もどかしいです。
--- 画面キャプチャ.rvb cut here ---
On error resume next
Dim arrNames, arrToolbars, arrName, arrToolbar
Dim arrVisname, arrVistoolbar,j,lngOldColor
j=0
'ツールバーを一時隠す
arrNames = Rhino.ToolbarCollectionNames
If IsArray(arrNames) Then
For Each arrName in arrNames
arrToolbars = Rhino.ToolbarNames(arrName)
If IsArray(arrToolbars) Then
For Each arrToolbar in arrToolbars
If Rhino.IsToolbarVisible(arrName,arrToolbar) Then
ReDim Preserve arrVisname(j) '9/19 追加
ReDim Preserve arrVistoolbar(j) '9/19 追加
arrVisname(j)=arrName
arrVistoolbar(j)=arrToolbar
j=j+1
Rhino.HideToolbar arrName, arrToolbar
End If
Next
End IF
Next
End If
'背景を白にして画面のキャプチャをとる
'Rhino.Redraw
lngOldColor = Rhino.AppearanceColor(0)
Rhino.AppearanceColor 0, RGB(255,255,255)
Rhino.Command "_ScreenCaptureToFile"
Rhino.AppearanceColor 0, lngOldColor
'ツールバーの再表示
If IsArray(arrVisname) Then
For i = 0 TO UBound(arrVisname)
Rhino.ShowToolbar arrVisname(i), arrVistoolbar(i)
Next
End If
--- 画面キャプチャ.rvb cut here ---
----
sugi です。
昨日はちゃんと動作してたはずなのですが、寝ぼけてたかも。
先のスクリプトだとエラーになりますね。
配列の扱い方が良く分からないので、Split を使って書き直してみました。
ツールバーは相変わらず消えてくれません。
--- 画面キャプチャ.rvb cut here ---
On error resume next
Dim arrNames, arrToolbars, arrName, arrToolbar
Dim arrVisname, arrVistoolbar,j,lngOldColor
Dim strVisname,strVistoolbar
j=0
strVisname=""
strVistoolbar=""
'ツールバーを一時隠す
arrNames = Rhino.ToolbarCollectionNames
If IsArray(arrNames) Then
For Each arrName in arrNames
arrToolbars = Rhino.ToolbarNames(arrName)
If IsArray(arrToolbars) Then
For Each arrToolbar in arrToolbars
If Rhino.IsToolbarVisible(arrName,arrToolbar) Then
strVisname=strVisname+arrName+","
strVistoolbar=strVistoolbar+arrToolbar+","
j=j+1
Rhino.HideToolbar arrName, arrToolbar
End If
Next
End IF
Next
End If
'背景を白にして画面のキャプチャをとる
'Rhino.Redraw
lngOldColor = Rhino.AppearanceColor(0)
Rhino.AppearanceColor 0, RGB(255,255,255)
Rhino.Command "_ScreenCaptureToFile"
Rhino.AppearanceColor 0, lngOldColor
'ツールバーの再表示
arrVisname=Split(strVisname,",")
arrVisToolbar=Split(strVisToolbar,",")
If IsArray(arrVisname) Then
For i = 0 TO UBound(arrVisname)-1
'msgbox arrVisname(i) +" "+arrVistoolbar(i)
Rhino.ShowToolbar arrVisname(i), arrVistoolbar(i)
Next
End If
--- 画面キャプチャ.rvb cut here ---
----
-寝ぼけてた原因がわかりました。先のスクリプトに ReDim の行を追加してみました。 -- [[sugi]] &new{2005-09-19 14:46:04 (月)};
----
sugi です。
なぜか途中でユーザーによる入力待ちの状態にしてやらないと画面の再表示が
されないようです。
zoom コマンドを入れることで回避できました。
最終的には次のようになりました。
配列の扱い方などはまだ良く分からないのですが、一応、ほぼ希望の動作にな
ったので、これで完了としたいと思います。
--- 画面キャプチャ.rvb cut here ---
On error resume next
Dim arrNames, arrToolbars, arrName, arrToolbar
Dim arrVisname, arrVistoolbar,j,lngOldColor
Dim strVisname,strVistoolbar,strTitle
j=0
strVisname=""
strVistoolbar=""
'ツールバーを一時隠す
arrNames = Rhino.ToolbarCollectionNames
If IsArray(arrNames) Then
For Each arrName in arrNames
arrToolbars = Rhino.ToolbarNames(arrName)
If IsArray(arrToolbars) Then
For Each arrToolbar in arrToolbars
If Rhino.IsToolbarVisible(arrName,arrToolbar) Then
strVisname=strVisname+arrName+","
strVistoolbar=strVistoolbar+arrToolbar+","
j=j+1
Rhino.HideToolbar arrName, arrToolbar
End If
Next
End IF
Next
End If
'View タイトルはいらない
strTitle = Rhino.CurrentView
Rhino.ShowViewTitle strTitle, vbfalse
'グリッドはいらない、グリッド軸表示
Rhino.command "noecho -_DocumentProperties _G _H=_NO _O=_YES !"
'ズームで入力待ちにしてツールバーを非表示にする
Rhino.command "_zoom "
'背景を白にして画面のキャプチャをとる
lngOldColor = Rhino.AppearanceColor(0)
Rhino.AppearanceColor 0, RGB(255,255,255)
Rhino.Command "_ScreenCaptureToFile"
Rhino.AppearanceColor 0, lngOldColor
'ツールバーの再表示
arrVisname=Split(strVisname,",")
arrVisToolbar=Split(strVisToolbar,",")
If IsArray(arrVisname) Then
For i = 0 TO UBound(arrVisname)-1
'msgbox arrVisname(i) +" "+arrVistoolbar(i)
Rhino.ShowToolbar arrVisname(i), arrVistoolbar(i)
Next
End If
'View タイトル表示、グリッド、グリッド軸非表示
Rhino.ShowViewTitle strTitle, vbtrue
Rhino.command "noecho -_DocumentProperties _G _H=_NO _O=_NO !"
--- 画面キャプチャ.rvb cut here ---
----
-SR4にある「ボーナス」−「ビュー」−「ビューをクリップボードにキャプチャ」or「ビューをファイルにキャプチャ」コマンドを用いれば、アクティブなビューを任意の解像度でキャプチャできます。と[[Newsgroup:http://news2.mcneel.com/scripts/dnewsweb.exe?cmd=xover&group=rhino.japanese]]に[[Seiji Onai]]さんから投稿ありました。 -- [[kitta]] &new{2005-09-21 10:29:59 (水)};
-情報ありがとうございます。当方 SR3 なので、確認はできませんが、ちょっと意図するものとは異なるような気がします。加工の指示や客先との打ち合わせのために画面のキャプチャをとりたい時に便利なように従来のコマンドを組み合わせただけで、まったく新しいコマンドを作りたいわけではありません。自分の希望通りの出力が得られるように、融通をきかせて書けるのがスクリプトの良い点だと思いますが、まだ慣れないもので、試行錯誤しております。 -- [[sugi]] &new{2005-09-21 22:19:00 (水)};
#comment
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
