Hello
I'm looking to modify a macro found on the internet, which was probably never finished.
The goal would be to modify the fixed face of a sheet metal part by offering the user the possibility to choose his own face on the 3D model.
Even though I've been walking around for 2 days, I admit that I'm drying up a little.
Here is the modified macro:
Option Explicit
Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
'Dim boolstatus As Boolean
'Dim longstatus As Long, longwarnings As Long
'Dim swCustPrpMgr As SldWorks.CustomPropertyManager
Dim Value As String
Dim swPart As SldWorks.ModelDoc2
Dim Options As Variant
Dim SelMgr As SldWorks.SelectionMgr
Dim seltype As Variant
Dim isThisAPlane As Boolean
Dim swConfig As SldWorks.Configuration
Dim Test As Variant
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If (swModel.GetType <> swDocPART) Then
MsgBox "Please open a Sheet Metal Part first and then try again!"
Exit Sub
Else
'Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
'swCustPrpMgr.Get3 "Thickness", False, "", Value
'swCustPrpMgr.Get3 "Epaisseur de tôlerie", False, "", Value
'Debug.Print "Epaisseur:" & Value
Set swFeat = swModel.FirstFeature 'Gets the first feature in the part document.
'Loops through the features until 'FlatPattern' feature if found.
Do Until swFeat Is Nothing
'Checks whether the feature type is 'FlatPattern' or not.
'Debug.Print "Type name:" & swFeat.GetTypeName
'Debug.Print "Name:" & swFeat.Name
If swFeat.GetTypeName = "FlatPattern" Then
Dim bRet As Boolean
Dim swFlatPatt As SldWorks.FlatPatternFeatureData
Dim swFixedFace As SldWorks.Face2
Dim selectData As SldWorks.selectData
Set SelMgr = swModel.SelectionManager
'xxxxxxxxxxxxxxxxxxxxxxxxx
'I need code here to select the face
' 'did the user pre-select a face?
' seltype = SelMgr.GetSelectedObjectType2(1)
' If SelMgr.GetSelectedObjectCount <> 1 Then
' seltype = SelMgr.GetSelectedObjectType3(1, 0)
' If (seltype <> SwConst.swSelFACES) Then
' ' 'user did not preselect one face
' swApp.SendMsgToUser "Please select a (one) 2D face before running this command."
' GoTo cleanupandquit
' End If
' End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxx
Set swFlatPatt = swFeat.GetDefinition
bRet = swFlatPatt.AccessSelections(swModel, Nothing)
Set swFixedFace = swFlatPatt.FixedFace2
' Set swFixedFace = seltype
bRet = swFixedFace.Select4(True, selectData)
' Stop
swFlatPatt.ReleaseSelectionAccess
swFeat.SetSuppression (1)
swFeat.SetSuppression (0)
Else
End If
Set swFeat = swFeat.GetNextFeature 'Gets the next feature in part document.
Loop
End If
cleanupandquit:
Set swConfig = Nothing
Set swApp = Nothing
Set swModel = Nothing
Set SelMgr = Nothing
End Sub
The original macro topic:
https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/?_gl=1n52pes_gaMjcxNTI5NDczLjE2NDAwNjkyNDQ._ga_XQJPQWHZHH*MTY3MzQyNzE4NC43Mi4wLjE2NzM0MjcyNTAuNjAuMC4w#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:koHtH74aQp2V8jPiw2IwYQ
Otherwise for the only API link found on the subject:
https://help.solidworks.com/2020/english/api/sldworksapi/get_fixed_face_of_sheet_metal_part_example_vb.htm?verRedirect=1
If you have even any leads, I am very interested.
Thank you in advance.
Sebastian
There may be an error in the macro because it does not allow the user to choose their own face on the 3D model. There are commented code sections that contain instructions for selecting a specific face, but these comments are not used. These comments should allow the user to select a face before running the macro, but because they are commented out, they are not used and the macro continues to use the fixed face by default. The code sections to be uncommented are:
'did the user pre-select a face?
seltype = SelMgr.GetSelectedObjectType2(1)
If SelMgr.GetSelectedObjectCount <> 1 Then
seltype = SelMgr.GetSelectedObjectType3(1, 0)
If (seltype <> SwConst.swSelFACES) Then
' 'user did not preselect one face
swApp.SendMsgToUser "Please select a (one) 2D face before running this command."
GoTo cleanupandquit
End If
End If
And
Set swFixedFace = seltype
a+
1 Like
Yes I have already tried to de-comment but I didn't get what I wanted. Nor the basic user who posted the question. I left this code commented out because it can help debug the initial code.
1 Like
What if you try with that? This code is used to check if the user has selected a face before continuing to run the macro:
Set SelMgr = swModel.SelectionManager
seltype = SelMgr.GetSelectedObjectType2(1)
If SelMgr.GetSelectedObjectCount <> 1 Then
seltype = SelMgr.GetSelectedObjectType3(1, 0)
If (seltype <> SwConst.swSelFACES) Then
'user did not preselect one face
swApp.SendMsgToUser "Please select a (one) 2D face before running this command."
GoTo cleanupandquit
End If
End If
In addition, swconst must be defined in your macro.
Then you can use the selection to set the fixed face in the FlatPattern feature:
Set swFlatPatt = swFeat.GetDefinition
bRet = swFlatPatt.AccessSelections(swModel, Nothing)
Set swFixedFace = seltype
bRet = swFixedFace.Select4(True, selectData)
1 Like
Hello @tous
Attached are two functions that I developed for one of my projects
The body is supported by face.getbody
Public Function get_flat_feature(bod As Body2) As Feature
Dim featurmgr As FeatureManager
Set featurmgr = swModel.FeatureManager
Dim flatpaternfolder As FlatPatternFolder
Set flatpaternfolder = featurmgr.GetFlatPatternFolder()
Dim flatfeatures As Variant
flatfeatures = flatpaternfolder.GetFlatPatterns()
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Dim face As Face2
Dim feat As Variant
For Each feat In flatfeatures
Set sFlatPatternFeatureData = feat.GetDefinition()
Set face = sFlatPatternFeatureData.FixedFace2
If face.GetBody.name = bod.name Then
Set get_flat_feature = feat
Exit Function
End If
Next
End Function
Public Sub set_fixed_face(feat As Feature, face As Face2)
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Set sFlatPatternFeatureData = feat.GetDefinition()
sFlatPatternFeatureData.AccessSelections swModel, Nothing
sFlatPatternFeatureData.FixedFace2 = face
feat.ModifyDefinition sFlatPatternFeatureData, swModel, Nothing
End Sub
2 Likes
The first function locates the unfolded state for a multibody
The face is assumed to be selected before the function is named.
If you want to wait for a selection, let me know 
The initial solution does not work, the selection is done well but the face is not modified like this.
For your @Lynkoa15 solution, I'll look at what it looks like.
On the other hand, no multibody part for us one sheet = one part.
And the idea is to go through an after-the-fact selection because it's to be implemented in an existing macro so it's not possible to select the face in 1st.
In any case, thank you to you 2 for the tracks and I continue to dig on my side!
ENCLOSED A MINIMUM
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set selManager = swModel.SelectionManager
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim swFace1 As Face2
Do While swFace1 Is Nothing
Set swFace1 = selManager.GetSelectedObject6(1, -1)
DoEvents
Loop
set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
1 Like
Thanks @Lynkoa15 , I just tried your latest code and it gets stuck on the line in yellow (error 424-Object required):
However, I selected my face well and the DoEvents (which I didn't know) does the job well.
I have attached my part for testing as needed (sw2020)
Item1.SLDPRT (250.3 KB)
For me it works
Did you glue the dim swmodel before the main() function
Make sure that the mouse pointer and in the main() function (sometimes the compiler tries to execute the current function)
Otherwise for the piece nothing particular just have to move the bar taken up at the end
1 Like
I was missing the declarations above the main, after adding it works much better!
The full code as a reminder:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set selManager = swModel.SelectionManager
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim swFace1 As Face2
Do While swFace1 Is Nothing
Set swFace1 = selManager.GetSelectedObject6(1, -1)
DoEvents
Loop
set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'code
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Public Function get_flat_feature(bod As Body2) As Feature
Dim featurmgr As FeatureManager
Set featurmgr = swModel.FeatureManager
Dim flatpaternfolder As FlatPatternFolder
Set flatpaternfolder = featurmgr.GetFlatPatternFolder()
Dim flatfeatures As Variant
flatfeatures = flatpaternfolder.GetFlatPatterns()
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Dim face As Face2
Dim feat As Variant
For Each feat In flatfeatures
Set sFlatPatternFeatureData = feat.GetDefinition()
Set face = sFlatPatternFeatureData.FixedFace2
If face.GetBody.Name = bod.Name Then
Set get_flat_feature = feat
Exit Function
End If
Next
End Function
Public Sub set_fixed_face(feat As Feature, face As Face2)
Dim sFlatPatternFeatureData As FlatPatternFeatureData
Set sFlatPatternFeatureData = feat.GetDefinition()
sFlatPatternFeatureData.AccessSelections swModel, Nothing
sFlatPatternFeatureData.FixedFace2 = face
feat.ModifyDefinition sFlatPatternFeatureData, swModel, Nothing
End Sub
1 Like
