Bonjour,

Quelqu'un sait-il si il est possible de faire des enregistrements/exports automatisés de chaque calque d'un même fichier Rhino en plusieurs fichiers Rhino (un calque enregistré sur un fichier individuel sans avoir à le faire manuellement un par un) ?

Merci d'avance !

Bonjour
RhinoScript ne permet pas d'automatiser l'export ou l'enregistrement de fichier... donc avec le script ci-dessous il y a un peu d'intervention humaine.
Il faut supprimer les calques vides de ton dossier ( pour eviter les accidents enregistre une copie de ton dossier et fait l'essai avec cette copie )

Donc lorsqu'on lance le script il va successivement selectionner les objets calques par calques et faire un export, il faut donner un nom pour chacun des calques exportés, pour essayé j'ai simplement tapé 1,2,3 ...
On retrouve après dans le dossier un ensemble de fichiers 1,2,3... avec chacun un seul calque.

Option Explicit
'Script written by Phil Shapiro
'Script copyrighted by Cadlantique
'Script version Friday, 28 May 2010 11:03:22

Call Main()
Sub Main()
Dim arrLayers, strLayer, LayerToClose

arrLayers = Rhino.LayerNames

If IsArray(arrLayers) Then
For Each strLayer In arrLayers
Rhino.CurrentLayer (strLayer)
For Each LayerToClose In arrLayers
If Rhino.IsLayerCurrent(LayerToClose) Then
Rhino.Print "The layer is current."
Else
If Rhino.IsLayerEmpty(LayerToClose) Then
Rhino.Print "The layer is empty."
Else
Call Rhino.LayerLocked(LayerToClose, True )
End If
End If
Next
Call Rhino.Command("_SelAll")
Call Rhino.Command ("_Export")
Call Rhino.Command("_SelNone")
Next
End If
End Sub

Si tu souhaite faire tourner le script a partir d'une icone n'oublie pas de l'encadrer avec les lignes suivantes

!-_RunScript
(
"ICI TU COPIE LE SCRIPT"
)

Bonjour à tous,

I know this is an old post, but I found this in my script library. It automatically exports each layer in a file to a separate .3dm file, naming each file with (OriginalFileName-LayerName.3dm). It will ignore locked or empty layers; locked or hidden objects on visible layers are not exported either. If the original file has not been saved, the user is asked for a destination folder and the prefix will be "Untitled" or "Sans titre" (the prompts are localized).

As they say in netspeak, FWIW... (for what it's worth)

Ciao, --M

Hmmm, apparently one cannot post script files as attachments... was afraid of that...

Here is the script "en clair".... --M

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Option Explicit
'Script by Mitch Heynick
'Version 10 May, 2010
'Updated 20 August - added localization

Call ExportLayersAsFiles()
Sub ExportLayersAsFiles()

Dim arrLayers,strLayer,arrObjs,arrMsgs
Dim strFilePathName,docName,docPath,strComm
arrMsgs=Localize()

docName=Rhino.DocumentName()
docPath=Rhino.DocumentPath()
If IsNull(docName) Then 'file has not been saved yet
docName=(arrMsgs(1))
docPath=Rhino.BrowseForFolder(,arrMsgs(0))
Else
docName=Left(docName,Len(docName)-4) 'remove extension
End If

arrLayers=Rhino.LayerNames
For each strLayer in arrLayers
Call Rhino.UnselectAllObjects
If Not Rhino.IsLayerEmpty(strLayer) or Not Rhino.IsLayerLocked(strLayer) Then
arrObjs=Rhino.ObjectsByLayer(strLayer,True)
If IsArray(arrObjs) Then
strFilePathName=docPath&docName&"-"&strLayer&".3dm"
strComm="_-Export "&chr(34)&strFilePathName&chr(34)&" _Enter"
Call Rhino.Command(strComm,False)
End If
End If
Next
End Sub

Function Localize()
Dim intLCID
intLCID=Rhino.LocaleID

Dim str0,str1
If intLCID=1036 Then
str0="Choisir un dossier pour les fichiers"
str1="Sans titre"
Else
str0="Select destination folder for files"
str1="Untitled"
End If

Localize=Array(str0,str1)
End Function