Bonjour la communauté,
Je voudrais savoir si il existe une macro pour enregistrer sous STL une seul pièce (sélectionner parmi d'autres) ou si on peu enregistrer tout les corps d'une seul pièce indépendamment ? Si vous avez des tutos ou une macro similaire cela me serrai hyper utile :)
Bonjour,
J'ai déjà fait ce type de macro pour du step mais c'est globalement pareil pour du stl.
Option Explicit
Dim swApp As Object
Dim swPart As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim Indent As Long
Dim BodyFolderType(5) As String
Dim sModelName As String
Dim iNbCar As Integer
Dim boolstatus As Boolean
Dim fileName As String
Dim file2save As String
Dim swErrors As Long
Dim swWarnings As Long
Dim bRet As Boolean
Sub main()
BodyFolderType(0) = "dummy"
BodyFolderType(1) = "swSolidBodyFolder"
BodyFolderType(2) = "swSurfaceBodyFolder"
BodyFolderType(3) = "swBodySubFolder"
BodyFolderType(4) = "swWeldmentSubFolder"
BodyFolderType(5) = "swWeldmentCutListFolder"
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Call StlParam
Debug.Print "File = " & swPart.GetPathName
fileName = swPart.GetPathName
fileName = Strings.Left(fileName, Len(fileName) - 7)
Indent = -3
Set swFeat = swPart.FirstFeature
TraverseFeatures swFeat, True
End Sub
Sub StlParam()
boolstatus = swApp.SetUserPreferenceToggle(swSTLBinaryFormat, True) 'Paramètre la sortie en tant que fichier Binaire
boolstatus = swApp.SetUserPreferenceIntegerValue(swExportStlUnits, 0) 'Parmaètre les unités à millimètres
boolstatus = swApp.SetUserPreferenceIntegerValue(swSTLQuality, swSTLQuality_e.swSTLQuality_Fine) 'Paramètre la résolution du fichier en fin
boolstatus = swApp.SetUserPreferenceToggle(swSTLShowInfoOnSave, True) 'Permet d'afficher les infos STL (maillage) avant d'enregistrer
boolstatus = swApp.SetUserPreferenceToggle(swSTLComponentsIntoOneFile, True) 'Paramètre l'enregistrement des composants d'un assemblage dans un seul fichier
End Sub
Sub DoTheWork(thisFeat As SldWorks.Feature)
Dim IsBodyFolder As Boolean
IsBodyFolder = False
Dim FeatType As String
FeatType = thisFeat.GetTypeName
If FeatType = "SolidBodyFolder" Then IsBodyFolder = True
If IsBodyFolder Then
Debug.Print Format(String(Indent, " ") & thisFeat.Name, "!" & String(40, "@")); Format(FeatType, "!" & String(30, "@"));
Dim BodyFolder As SldWorks.BodyFolder
Set BodyFolder = thisFeat.GetSpecificFeature2
Dim BodyFolderTypeE As Long
BodyFolderTypeE = BodyFolder.Type
Debug.Print Format(BodyFolderType(BodyFolderTypeE), "!" & String(30, "@")); Format(BodyFolderTypeE, "!@@@@");
Dim BodyCount As Long
BodyCount = BodyFolder.GetBodyCount
Debug.Print "Body Count is " & BodyCount
Dim vBodies As Variant
vBodies = BodyFolder.GetBodies
Dim i As Long
If Not IsEmpty(vBodies) Then
For i = LBound(vBodies) To UBound(vBodies)
Dim Body As SldWorks.Body2
Set Body = vBodies(i)
sModelName = Body.Name
If InStr(sModelName, "[") <> 0 Then
iNbCar = Len(sModelName) - (Len(sModelName) - InStr(sModelName, "[")) - 1
sModelName = Left(sModelName, iNbCar)
End If
Debug.Print sModelName
boolstatus = swPart.Extension.SelectByID2(Body.Name, "SOLIDBODY", 0, 0, 0, False, 0, Nothing, 0)
file2save = fileName & " - " & sModelName & ".stl"
Debug.Print file2save
boolstatus = swPart.SaveToFile2(file2save, swSaveAsOptions_e.swSaveAsOptions_Silent, swErrors, swWarnings)
Set swPart = swApp.ActiveDoc
swApp.CloseDoc (swPart.GetTitle)
Set swPart = swApp.ActiveDoc
'swPart.ClearSelection2 True
Debug.Print Format(String(Indent + 3, " ") & Body.Name, "!" & String(30, "@"))
Next i
End If
Dim FeatureFromBodyFolder As SldWorks.Feature
Set FeatureFromBodyFolder = BodyFolder.GetFeature
If Not FeatureFromBodyFolder Is thisFeat Then
MsgBox "Features don't match!"
End If
Else
End If
End Sub
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Dim curFeat As SldWorks.Feature
Set curFeat = thisFeat
Indent = Indent + 3
While Not curFeat Is Nothing
DoTheWork curFeat 'Do the thing that we are doing this feature traversal for
Dim subfeat As SldWorks.Feature
Set subfeat = curFeat.GetFirstSubFeature
While Not subfeat Is Nothing
TraverseFeatures subfeat, False
Dim nextSubFeat As SldWorks.Feature
Set nextSubFeat = subfeat.GetNextSubFeature
Set subfeat = nextSubFeat
Set nextSubFeat = Nothing
Wend
Set subfeat = Nothing
Dim nextFeat As SldWorks.Feature
If isTopLevel Then
Set nextFeat = curFeat.GetNextFeature
Else
Set nextFeat = Nothing
End If
Set curFeat = nextFeat
Set nextFeat = Nothing
Wend
Indent = Indent - 3
End Sub
En l'état, la macro paramètre les options stl. Si vous voulez que ceux-ci soient remis à l'origine après intervention de la macro, il faut récupérer les valeurs à l'origine au lancement de la macro puis les réappliquer en fin de traitement.
Malheureusement elle ne fonctionne pas chez moi, débogage au niveau de (paramètre la sortie en tant que fichier binaire), et je n ai pas les compétences pour résoudre le problème, je n'y connaît pas grand chose en codage... mais merci
Bonjour, il faut un fichier d'ouvert pour accéder aux paramétrages sinon ça plante.
On peut ajouter un contrôle sur le fait qu'un fichier soit ouvert ou non. A insérer avant Call StlParam
If swPart Is Nothing Then MsgBox ("Pas de document ouvert"): Exit Sub
Bonjour,
Même ave un fichier ouvert cela m'affiche cela(PJ), je suis vraiment désolé mais je m'y connais très peu en édition de macro, j'ai essayé mais n'ayant jamais vraiment coder c'est difficile.. Pouvez vous m'indiqué la façon de faire la macro ou serrai t'il possible d'avoir directement la macro ?
Est-ce que Dim swApp est bien mis en As Object?
Quelle version de SW? C'est fonctionnel sur 2014/2016/2018 (versions par laquelle est passée la macro)
Bonjour,
Ca marche très bien sur SW2017 aussi, vérifie ce que tu as comme références dans l'éditeur de macro (Outils/Références...).
Cordialement,
Bonsoir,
"Truc" bête mais vous lancez bien à partir de la partie Sub_Main?
Bonjour,
Oui je suis bien sur SW 2018 et voici en PJ mes références.
J'ai copié collé votre document dans l'éditeur de macro solidworks... Y a t'il une démarche spécifique à faire ?
Merci de m'aider à comprendre et a utiliser la macro :)
Bonjour,
La seule démarche c'est lorsque vous lancez la macro si votre curseur n'est pas dans le bloc identifié entre Sub_main et end sub, vous devez sélectionner Macrox.modulex.main (le x étant probablement 1).
A terme si vous choisissez de mettre cette macro sur un bouton personnalisé, il faudra sélectionner le chemin d'accès et la macro dans le champ "Macro" puis dans le champ "Méthode" sélectionner Macrox.main
Bonsoir,
Malheureusement Cyril.f, je fais tout comme vous l'indiquer mais cela ne fonctionne pas. Est ce que je peux me permettre de vous demander de faire un Tuto ou une suite de capture d'ecran pour que je comprenne.... JE ne vois pas pourquoi elle ne fonctionne pas..
Bonsoir,
Très franchement, je ne vois pas où pourrait être le problème et des captures d'écran ne résoudrait pas le problème je pense. Si d.roger a une idée
Bonsoir,
Je n'ai pas Solidworks sous la main donc pas possible de faire d'images des différentes étapes.
Quelques vérifications :
- As-tu accès aux options d'export en STL en manuel (ouvrir une pièce, aller dans Option du système / Exporter / Format STL) ?
- As-tu bien qu'un seul processus sldworks.exe de lancé ?
- Es-tu administrateur sur ton PC ?
Pour créer ta macro il faut faire :
- Démarrer Solidworks (accessoirement, vérifier qu'il n'y a bien qu'un seul processus sldworks.exe de lancé).
- Créer une nouvelle pièce que tu enregistres dans un dossier sur lequel tu as des droits d'écriture (sur le bureau par exemple).
- Aller dans Outils / Macro / Nouvelle.
-Dans la fenêtre VBA qui s'ouvre, il faut tout supprimer puis coller tout le texte de la macro de Cyril.f.
- Positionner le curseur sur une ligne du module Main.
- Lancer la macro.
Cela doit fonctionner et te créer un fichier stl de ta pièce, celui-ci est stocké au même endroit que ta pièce sldprt.
Si ça bloque au même endroit que précédemment tu peux mettre en commentaire la ligne "Call StlParam" qui se trouve dans le Sub Main() ainsi que toutes les lignes qui se trouvent dans "Sub StlParam()" et relancer la macro pour voir si celle-ci fonctionne.
Cordialement,
Merci !!!! Cela fonctionne lorsque je l'active de cette façon. J'activais la macro via le bouton play, mais sans résultat probant. Cela ne fonctionne toujours pas lorsque je fait Exécuter la macro et sélectionner la macro alors que quand je l'édite et que je l'active elle fonctionne. Étrange ou normal ?
Bonjour,
OK, donc tu remplaces les lignes :
Sub StlParam() par Function StlParam()
Sub DoTheWork(thisFeat As SldWorks.Feature) par Function DoTheWork(thisFeat As SldWorks.Feature)
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean) par Function TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Tu vérifie ensuite que les lignes End Sub correspondant à ces fonctions ont bien été remplacées par End Function. Tu ne dois avoir qu'un seul bloc Sub dans ta macro, c'est le bloc de départ de la macro et cela devrait fonctionner sur appel par un bouton ou par Outils / Macro / Exécuter.
Si cela fonctionne alors tu pourras valider la meilleure réponse, c'est celle de Cyril.f ou il a mis tout le texte de la macro, c'est là qu'est tout le boulot.
Cordialement,
Bonjour,
Elle fonctionne parfaitement :) Merci beaucoup à vous deux spécialement à Cyril.f pour le partage de la macro, c'est fou comme quoi en travaillant sur le même logiciel nous avons pas dutout les mêmes fonctions, capacités et domaines d'activité. et merci a d.roger pour l'aide et la compréhension des macros qui n'est pas dutout dans mon domaine de compétence.
Bonjour,
Disons que lorsque l'on commence à regarder comment automatiser certaines tâches (SW n'avait pas certaines fonctionnalités à une époque de manière native) et que l'on est un poil autodidacte, on fini par avoir une certaine maîtrise des macros. Suffit globalement de se lancer, d'avoir un peu de temps, utiliser l'aide de l'API et les sites internet et on fini par acquérir un niveau suffisant en général.