Author Topic: Export all Blocks to indv. files zoomed to Extents  (Read 1280 times)

0 Members and 1 Guest are viewing this topic.

Antisthenes

  • Guest
Export all Blocks to indv. files zoomed to Extents
« on: March 17, 2007, 09:45:21 PM »
this script (copy save in *.rvb file) adds the command ExportAllBlocks to Rhinoceros 4 (  and zooms extents to them so you can see the thumbnails in explorer thumbnail mode after having CADpreviewImage installed
http://www.rhinocenter.fi/tools.php
http://www.rhinocenter.fi/tools/Rhino%20Preview%20Image.exe

this views DWG files and thumbnails too and is very useful to dig out some stuff of DWG files you would never know was there i found
blocks within blocks within blocks on one file that was 32 mb.  :))




Quote
Option Explicit

Private strOldPath, strOldZoom
If IsEmpty(strOldpath)Then
  strOldPath = Rhino.WorkingFolder
End If

If IsEmpty(strOldZoom) Then
  strOldZoom = "Yes"
End If


Sub ExportAllBlocks


Dim arrBlocks, strBlock, strPath, strTemp, str, arrFiles(), strFile
Dim arrZoom, strZoom, strCurrent
Dim i
i = 0

arrZoom = Array("Yes", "No")
strZoom = Rhino.GetString("Zoom extents on exported files?",strOldZoom, arrZoom)

  If Not IsNull (strZoom) Then
    strOldZoom = strZoom
    Else Exit Sub
  End If
   
   
     
  strCurrent = Rhino.DocumentPath &Rhino.DocumentName


  arrBlocks = Rhino.BlockNames
  If IsArray(BlockNames) Then
    strPath = Rhino.BrowseForFolder(strOldpath, "Save blocks to folder","Export Blocks")
      Else Exit Sub
  End If
 
     
  If Not IsNull(strPath) Then
        strOldPath = strpath
        Rhino.EnableRedraw(False)
    For Each strBlock In arrBlocks
      If Rhino.IsBlock (strBlock) Then
        strTemp = Rhino.InsertBlock(strBlock, Array(0,0,0))
        Rhino.SelectObject(strTemp)
        str = Chr(34) &strPath &"\" &Rhino.BlockInstanceName(strtemp) &".3dm"
&Chr(34)
        print str
        ReDim Preserve arrFiles(i)
        arrFiles(i) = str
        i = i + 1
        Rhino.Command "_-Export " &str &" Enter"
        Rhino.DeleteObject strTemp
      End If
    Next
    Rhino.EnableRedraw(True)
   Else Exit Sub
  End If


    If isUpperBound(arrFiles) And UCase(strZoom) = "YES" Then
      Rhino.Command "Save"
      Rhino.EnableRedraw(False)
      For Each strFile In arrFiles
        Rhino.Command "_-Open UpdatePromptUpdateBlocks=No " &strFile &" "
        Rhino.Command "_Zoom _All _Extents "
        Rhino.Command "_Save "
      Next
      If Not IsNull(strCurrent)Then
        Rhino.COmmand "_-Open " & Chr(34) &strCurrent &Chr(34) & " "
      End If
   
      Rhino.EnableRedraw(True)
     
    End If

 
End Sub
   
Rhino.AddStartUpScript Rhino.LastLoadedScriptFile
Rhino.AddAlias "ExportAllBlocks", "! _-Runscript ExportAllBlocks"