Hello
I would like to follow a request from our folders to modify one of our macros to make the cutting + folding plan, add via Vba an annotation indicating the fixed side of an unfolded on MEP.
The manual method to cange this face:
From a room I manage to retrieve this face in a selection with this code:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim selManager As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swFlatPatt As SldWorks.FlatPatternFeatureData
Dim lErrors As Long
Dim lWarnings As Long
Dim bRet As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set selManager = swModel.SelectionManager
'********************************************************************************
'A modifier pour sélectionner depuis une MEP au lieu de depuis la pièce
'********************************************************************************
If (swModel.GetType <> swDocPART) Then
MsgBox "Merci d'ouvrir une pièce de tôlerie avant de relancer!"
Exit Sub
End If
'On lance la fonction pour afficher la face fixe (= côté protection PVC)
get_fixed_face
Dim swFace1 As Face2
Dim reponse As Integer
reponse = MsgBox("Voulez vous sélectionner une autre face protégée (film PVC) pour la pièce de tôlerie?" + Chr(10) + "Si oui merci de sélectionner une nouvelle face une fois cette fenêtre fermé.", vbQuestion + vbYesNo + vbDefaultButton1, "Selection de la face protéger (PVC)")
If reponse = vbNo Then
'On descend la barre
swFlatPatt.ReleaseSelectionAccess
Exit Sub
Else
'On descend la barre
swFlatPatt.ReleaseSelectionAccess
End If
Do While swFace1 Is Nothing
Set swFace1 = selManager.GetSelectedObject6(1, -1)
DoEvents
Loop
'On lance les 2 fonctions imbriquées
set_fixed_face get_flat_feature(swFace1.GetBody), swFace1
'On sauvegarde les changements
bRet = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
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
Public Function get_fixed_face()
Set swFeat = swModel.FirstFeature 'Va au 1er feature dans la pièce.
'Tourne jusqu'à trouver un feature 'FlatPattern'.
Do Until swFeat Is Nothing
'On vérifie si le feature est 'FlatPattern' ou pas.
Debug.Print "Type name:" & swFeat.GetTypeName
Debug.Print "Name:" & swFeat.Name
If swFeat.GetTypeName = "FlatPattern" Then
Dim swFixedFace As SldWorks.Face2
Dim selectData As SldWorks.selectData
Set swFlatPatt = swFeat.GetDefinition
bRet = swFlatPatt.AccessSelections(swModel, Nothing)
Set swFixedFace = swFlatPatt.FixedFace2
bRet = swFixedFace.Select4(True, selectData)
'********************************************************************************
'Depuis cette sélection ajout d'une annotation sur la face sélectionné avec texte face fixe
'********************************************************************************
Exit Function
Else
End If
Set swFeat = swFeat.GetNextFeature 'Va au feature suivant.
Loop
End Function
Do you have any idea on how to:
1-Launch the macro from an MEP instead of from the room
2-Add the annotation on the selected side (Fixed side)
Point 1 seems feasible to me, point 2 I don't really see which function to use and some ideas would be welcome!
Thanks in advance
