Hello Community,
I would like to know if there is a macro to record a single part under STL (select among others) or if we can record all the bodies of a single part independently? If you have tutorials or a similar macro it would be very useful to me:)
Hello
I've already done this type of macro for step but it's basically the same for 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
As it stands, the macro sets the stl options. If you want them to be reset to the origin after the macro has intervened, you have to retrieve the values from the origin when the macro is launched and then reapply them at the end of processing.
Unfortunately it doesn't work for me, debugging at the level of (parameterizes the output as a binary file), and I don't have the skills to solve the problem, I don't know much about coding... but thank you
Hello, you need an open file to access the settings otherwise it crashes.
You can add a control over whether a file is open or not. To be inserted before Call StlParam
If swPart Is Nothing Then MsgBox ("Pas de document ouvert"): Exit Sub
Hello
Even with an open file it shows me this (PJ), I'm really sorry but I know very little about macro editing, I tried but never really coding it's difficult. Can you tell me how to do the macro or will it be possible to have the macro directly?
Is Dim swApp set to As Object?
Which version of SW? It's functional on 2014/2016/2018 (versions the macro went through)
Hello
It works very well on SW2017 too, check what you have as references in the macro editor (Tools/References...).
Kind regards
Good evening
Stupid "thing" but you throw well from the Sub_Main game?
Hello
Yes, I'm on SW 2018 and here are my references.
I have copied and pasted your document into the solidworks macro editor... Is there a specific procedure to be taken?
Thank you for helping me understand and use the macro:)
Hello
The only thing you can do is when you launch the macro, if your cursor is not in the identified block between Sub_main and end sub, you must select Macrox.modulex.main (the x is probably 1).
Eventually, if you choose to put this macro on a custom button, you will have to select the path and the macro in the "Macro" field and then in the "Method" field select Macrox.main
Good evening
Unfortunately Cyril.f, I do everything as you tell you but it doesn't work. Can I ask you to make a tutorial or a sequence of screenshots so that I understand.... I don't see why it doesn't work.
Good evening
Quite frankly, I don't see where the problem could be and screenshots wouldn't solve the problem I think. If d.roger has an idea
Good evening
I don't have Solidworks on hand so it's not possible to make images of the different steps.
A few checks:
- Do you have access to the STL export options manually (open a part, go to System Option / Export / STL Format)?
- Did you have only one process sldworks.exe launched?
- Are you an administrator on your PC?
To create your macro you need to do:
- Start Solidworks (incidentally, check that there is only one sldworks.exe process launched).
- Create a new document that you save in a folder on which you have writing rights (on the desktop for example).
- Go to Tools/Macro/News.
-In the VBA window that opens, you have to delete everything and then paste all the text of Cyril.f's macro.
- Position the cursor on a row in the Main module.
- Launch the macro.
This should work and create an stl file of your part, this is stored in the same place as your sldprt part.
If it gets stuck in the same place as before, you can comment out the "Call StlParam" line in the Sub Main() as well as all the lines in the "Sub StlParam()" and run the macro again to see if it works.
Kind regards
Thank you!!!! It works when I turn it on this way. I activated the macro via the play button, but without convincing results. It still doesn't work when I do Run Macro and select macro whereas when I edit it and turn it on, it works. Strange or normal?
Hello
OK, so you replace the lines:
Sub StlParam() by Function StlParam()
Sub DoTheWork(thisFeat As SldWorks.Feature) by Function DoTheWork(thisFeat As SldWorks.Feature)
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean) by Function TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
You then check that the End Sub lines corresponding to these functions have been replaced by End Function. You should only have one Sub block in your macro, this is the starting block of the macro and it should work on call by a button or by Tools/Macro/Run.
If it works then you can validate the best answer, it's Cyril.f' s where he put all the macro text, that's where all the work is.
Kind regards
Hello
It works perfectly :) Thank you very much to both of you especially to Cyril.f for sharing the macro, it's crazy how by working on the same software we don't have the same functions, capabilities and fields of activity at all. And thanks to D.Roger for the help and understanding of macros which is not at all in my field of expertise.
Hello
Let's say that when you start looking at how to automate certain tasks (SW didn't have certain features at one time natively) and you're a bit self-taught, you end up having a certain mastery of macros. Overall, you just have to get started, have a little time, use the help of the API and the websites and you end up acquiring a sufficient level in general.