Saving a Body

Out of category
1

Allo Group,

I'm new to this forum. I work with mechanically welded machines, i.e. with multiple bodies. I would like to save some bodies as a STEP, IGES file because my press controller can only open this type of file. There is the body save function (insertion/ function/save body) but it allows me to save only in  *. SLDPRT

Do you have any suggestions for another function? Otherwise, there are macro pros in the area, I must admit that I don't know too much about it but I can see a macro that would insert a body in a new room without saving it and that would save the part in STEP not the suite using the predefined name in a parameter.

Thank you all

2

Hello

You just need to create a configuration and delete (with the "delete/keep body" function) what your controller doesn't need and save it as a STEP.

3 Likes
3

Hello

Try this:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & " - " & swBody.Name & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub

 

4 Likes
4

Hello Jerome P,

You understood what I wanted unfortunately to the line to select a body, it blocks. I have the box that opens but I can't make any selection, I can just press OK and it ends the macro. I hope you can help me. Thank you so much.

5

WOWOWOOWOOOOO

I just caught that I have to select the body before launching the macro, it's too much to tick. I don't know if you can help me modify the function but I'd only like to add a dialog box to allow you to rename the file or better yet use the name of the body group rather than the name of the body. In my example, I'd like to use the name "30320.1 - PL0.25" rather than the default name "save body1", see image

Thank you

 


capture.png
6

OK. Try this:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub

Function GetCutList(swModel As SldWorks.ModelDoc2, BodyName As String) As String
    Dim swFeat As SldWorks.Feature
    Dim swBodyFolder As SldWorks.BodyFolder
    Dim swBody As SldWorks.Body2
    Dim vBodies As Variant
    Dim vBody As Variant
    Set swFeat = swModel.FirstFeature
    While Not swFeat Is Nothing
        If swFeat.GetTypeName = "CutListFolder" Then
            Set swBodyFolder = swFeat.GetSpecificFeature
            vBodies = swBodyFolder.GetBodies
            If Not IsEmpty(vBodies) Then
                For Each vBody In vBodies
                    Set swBody = vBody
                    If swBody.Name = BodyName Then
                        GetCutList = swFeat.Name
                        Exit Function
                    End If
                Next
            End If
        End If
        Set swFeat = swFeat.GetNextFeature
    Wend
    GetCutList = BodyName
End Function

 

2 Likes
7

OK it works 50-50 :(

When testing , the "getcutlist" function works well because the "FilePath" variable is always good. On the other hand,  the "savetofile3" does not work. I can see on the screen that the function is running because it opens the room but the file does not appear in the directory.

On the other hand, while doing tests, I realized one thing:

First,  I use the directory property "description" and SW renames my directories automatically. (see caption2) but if I haven't edited this parameter yet, for example, the last part directory (items-list-of-welded-parts19) or if I rename it manually. For example the first directory (test) then the macro works well and the step file appears in the directory.

Do you think it could be the brackets that SW writes at the end by default and that are used for I don't know what?

of the type   "... <#>... "  

Thank you.

 


capture2.png
8

Indeed, if there are invalid characters for the file name, it will not be saved.

Replaces: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ". STEP"

by: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & RegexStr(GetCutList(swModel, swBody.Name)) & ". STEP"

and adds the function:

Function RegexStr(ByVal Str As String) As String
Str = Split(Str, "<")(0)
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
With regex
    .Pattern = "[^-_ a-zA-Z0-9]"
    .Global = True
    .IgnoreCase = True
    .MultiLine = False
End With
RegexStr = regex.Replace(Str, "")
End Function

 

1 Like
9

Wow great!!

I've added a period to the end of regex.pattern(. Pattern = "[^-_ a-zA-Z0-9.] ") because the function deleted them (Thanks google).

Thank you for your support, I will never be able to do it alone.

You are a god of programming and I would like to become one of your disciples. :)

Thank you again, you make my day...

 

2 Likes