Hello
I have several assemblies of 150 parts, and I'm looking to have a macro that goes through all the parts, works them, does the function recognition, saves, closes and moves on to the next one. to not do everything manually.
I've tried several things but I can't select my import body to start the recognition. ect what you would have a solution.
Option Explicit
' ------------------------------------------------------------------
' Macro : Reconnaissance_Fonctions_Assemblage.swp
' ------------------------------------------------------------------
Dim swApp As SldWorks.SldWorks
Dim processed As Collection
Const swActivateDocOptions_Silent As Long = 1
Const swActivateDocError_NoError As Long = 0
'====================== Point d’entrée ============================
Sub main()
Dim swModel As ModelDoc2
Dim swAssy As AssemblyDoc
Dim vComps As Variant
Dim swComp As Component2
Dim compPath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Or swModel.GetType <> swDocASSEMBLY Then
MsgBox "Veuillez d’abord ouvrir un assemblage (*.SLDASM).", vbExclamation
Exit Sub
End If
Set swAssy = swModel
vComps = swAssy.GetComponents(True)
Set processed = New Collection
Dim i As Long
For i = LBound(vComps) To UBound(vComps)
Set swComp = vComps(i)
If Not swComp.IsSuppressed Then
compPath = swComp.GetPathName
If LCase$(compPath) Like "*.sldprt" Then
AddIfNewAndProcess compPath
End If
End If
Next i
MsgBox "Traitement terminé !", vbInformation
End Sub
'=================== Ajout + dispatch pièce ======================
Sub AddIfNewAndProcess(partPath As String)
On Error Resume Next
processed.Add partPath, partPath
If Err.Number = 0 Then
On Error GoTo 0
ProcessPart partPath
Else
Err.Clear
End If
End Sub
'================== Traitement individuel pièce ==================
Sub ProcessPart(partPath As String)
Dim partDoc As ModelDoc2
Dim featApp As FeatureWorks.IFeatureWorksApp
Dim feat As Feature
Dim errs As Long, warns As Long, actErr As Long, loadStat As Long
'--- 1. Ouvrir la pièce
Set partDoc = swApp.OpenDoc6(partPath, swDocPART, swOpenDocOptions_Silent, "", errs, warns)
If partDoc Is Nothing Then Exit Sub
'--- 2. Activer la pièce
Dim activated As ModelDoc2
Set activated = swApp.ActivateDoc3(partDoc.GetTitle, False, swActivateDocOptions_Silent, actErr)
If actErr <> swActivateDocError_NoError Then GoTo CleanUp
partDoc.ClearSelection2 True
'--- 3. Charger FeatureWorks
Set featApp = swApp.GetAddInObject("FeatureWorks.FeatureWorksApp")
If featApp Is Nothing Then
loadStat = swApp.LoadAddIn("FeatureWorks")
If loadStat = 0 Then
Set featApp = swApp.GetAddInObject("FeatureWorks.FeatureWorksApp")
End If
End If
If featApp Is Nothing Then GoTo CleanUp
'--- 4. Trouver et sélectionner la fonction "Imported"
Set feat = FindImportedFeature(partDoc)
If feat Is Nothing Then GoTo CleanUp
feat.Select2 False, 0 ' Sélectionne le corps importé
'--- 5. Lancer la reconnaissance automatique
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs + fwBaseFlange + fwSketchedBend + _
fwAutoEdgeFlange + fwAutoHemFlange
Dim vRes As Variant
vRes = featApp.RecognizeFeatureAutomatic(optAll)
'--- 6. Créer les fonctions reconnues
Const createOpt As Long = fwAllowFailFeatureCreation
featApp.CreateFeatures createOpt
CleanUp:
'--- 7. Sauvegarder et fermer
partDoc.Save3 swSaveAsOptions_Silent, errs, warns
swApp.CloseDoc partDoc.GetTitle
End Sub
'============= Trouver la fonction "Imported" dans l'arbre =========
Function FindImportedFeature(doc As ModelDoc2) As Feature
Dim feat As Feature
Set feat = doc.FirstFeature
Do While Not feat Is Nothing
Debug.Print "Feature : " & feat.Name & " / Type = " & feat.GetTypeName2
If feat.GetTypeName2 = "Imported" Or feat.GetTypeName2 = "BaseBody" Then
Debug.Print "? Fonction Importée trouvée : " & feat.Name
Set FindImportedFeature = feat
Exit Function
End If
Set feat = feat.GetNextFeature
Loop
Debug.Print "Aucune fonction 'Imported' ou 'BaseBody' trouvée dans : " & doc.GetPathName
Set FindImportedFeature = Nothing
End Function
1 Like
Hello
The problem seems to be in the activation of FeatureWorks.
As coded (and also presented in the API help) SW is unable to activate the add-in, hence the failure of the macro (which stops on this line: If featApp Is Nothing Then GoTo CleanUp)
Edit: By enabling FeatureWorks manually, the macro continues processing
1 Like
My featureworks add-in is enabled by default though
1 Like
Re
I retested, so the function expects at first glance a selection of the face and not the body.
It is therefore necessary to modify to recover a face.
2 Likes
Unless you only have cubes or cylinders, it's daring to use automatic recognition on a batch of parts.
Already in manual piece by piece (and function by function) I have never managed to recover something clean.
1 Like
I managed to get that.
It works well but I wouldn't want the sheet metal functions just the standard functions.
and I can't take them off. When I remove the sheet metal function from the code in block 5, it doesn't recognize at all. I don't understand why
' 5. Reconnaissance automatique avec tolerie
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs + fwBaseFlange + fwSketchedBend + _
fwAutoEdgeFlange + fwAutoHemFlange
featApp.RecognizeFeatureAutomatic optAll
' 5. Reconnaissance automatique sans tolerie
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs
featApp.RecognizeFeatureAutomatic optAll
Option Explicit
' ------------------------------------------------------------------
' Macro : Reconnaissance_Fonctions_Assemblage.swp
' ------------------------------------------------------------------
Dim swApp As SldWorks.SldWorks
Dim processed As Collection
Const swActivateDocOptions_Silent As Long = 1
Const swActivateDocError_NoError As Long = 0
'====================== Point d’entrée ============================
Sub main()
Dim swModel As ModelDoc2, swAssy As AssemblyDoc
Dim vComps As Variant, swComp As Component2
Dim compPath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Or swModel.GetType <> swDocASSEMBLY Then
MsgBox "Ouvrez d’abord un assemblage (*.SLDASM).", vbExclamation
Exit Sub
End If
Set swAssy = swModel
vComps = swAssy.GetComponents(True) ' récursif
Set processed = New Collection
Dim i As Long
For i = LBound(vComps) To UBound(vComps)
Set swComp = vComps(i)
If Not swComp.IsSuppressed Then
compPath = swComp.GetPathName
If LCase$(compPath) Like "*.sldprt" Then _
AddIfNewAndProcess compPath
End If
Next i
MsgBox "Traitement terminé !", vbInformation
End Sub
'=================== Évite les doublons ===========================
Sub AddIfNewAndProcess(partPath As String)
On Error Resume Next
processed.Add partPath, partPath
If Err.Number = 0 Then
On Error GoTo 0
ProcessPart partPath
Else
Err.Clear
End If
End Sub
'================== Traitement individuel =========================
Sub ProcessPart(partPath As String)
Dim partDoc As ModelDoc2, featApp As FeatureWorks.IFeatureWorksApp
Dim errs As Long, warns As Long, actErr As Long
' 1. Ouvrir la pièce
Set partDoc = swApp.OpenDoc6(partPath, swDocPART, _
swOpenDocOptions_Silent, "", errs, warns)
If partDoc Is Nothing Then Exit Sub
' 2. Activer la fenêtre
Dim activated As ModelDoc2
Set activated = swApp.ActivateDoc3(partDoc.GetTitle, False, _
swActivateDocOptions_Silent, actErr)
If actErr <> swActivateDocError_NoError Then GoTo CleanUp
partDoc.ClearSelection2 True
partDoc.ForceRebuild3 False ' assure noms & corps
' 3. Obtenir FeatureWorks (déjà chargé)
Set featApp = swApp.GetAddInObject("FeatureWorks.FeatureWorksApp")
If featApp Is Nothing Then GoTo CleanUp
' 4. Sélectionner la première face du premier corps solide
Dim swPart As partDoc, body As Body2, faces As Variant, face As Face2
Dim status As Boolean
Set swPart = partDoc
faces = Empty
Dim bodies As Variant
bodies = swPart.GetBodies2(swSolidBody, False)
If IsEmpty(bodies) Then GoTo CleanUp
Set body = bodies(0)
faces = body.GetFaces
If IsEmpty(faces) Then GoTo CleanUp
Set face = faces(0)
status = face.Select2(False, 0)
If Not status Then GoTo CleanUp ' impossible de sélectionner
' 5. Reconnaissance automatique
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs + fwBaseFlange + fwSketchedBend + _
fwAutoEdgeFlange + fwAutoHemFlange
featApp.RecognizeFeatureAutomatic optAll
' 6. Créer les fonctions
Const createOpt As Long = fwAllowFailFeatureCreation
featApp.CreateFeatures createOpt
CleanUp:
' 7. Sauvegarder & fermer
partDoc.Save3 swSaveAsOptions_Silent, errs, warns
swApp.CloseDoc partDoc.GetTitle
End Sub
1 Like
I'm in carpentry, it's only furniture, so rectangular panels with basic drilling and machining, and I need the recognition to apply my machining with SWOODCAM behind
1 Like
Hello, by removing fwSketchedBend I still have the sheet metal function
Ideally, I would just need this:
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs
featApp.RecognizeFeatureAutomatic optAll
except that if I remove the others it doesn't work anymore nothing happens in the treatment
Hello;
I wonder if we shouldn't start by ordering the functions to be recognized in the feaureWorks options.
What are the settings at home (or " at home ", I never know if it's simpler/cordial to use "tu" or "tu")...
Hello
I currently have the same settings as you, which must be the default ones I think