スクリプト関連/3

--- 画面キャプチャ.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 ---

--- 画面キャプチャ.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 ---

--- 画面キャプチャ.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 ---