Bonjour
j’ai plusieurs assemblage de 150 pièces, et je cherche a avoir une macro qui parcours toutes pièces, les ouvres, fasse la reconnaissance de fonction, enregistre, ferme et passe à la suivante. pour pas tout faire manuellement.
j’ai essayé plusieurs chose mais je n’arrive pas a sélectionner mon corps importer pour lancer la reconnaissance. ect ce que vous auriez une 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 « J'aime »
Bonjour,
Le problème semble être dans l’activation de FeatureWorks.
Tel que codé (et également présenté dans l’aide de l’API) SW n’arrive pas à activer le complément d’où l’échec de la macro (qui se stoppe sur cette ligne : If featApp Is Nothing Then GoTo CleanUp)
Edit: En activant FeatureWorks manuellement, la macro continue le traitement
1 « J'aime »
mon complément featureworks est bien activé par défaut pourtant
1 « J'aime »
Re,
J’ai retesté, donc la fonction attend à première vue une sélection de face et non de corps.
Il faut donc modifier pour récupérer une face.
2 « J'aime »
A moins de n’avoir que des cubes ou des cylindres c’est osé d’utiliser la reconnaissance automatique sur un lot de pièces.
Déjà en manuel pièce à pièce (et fonction par fonction) je ne suis jamais arrivé à récupérer quelque chose de propre.
1 « J'aime »
j’ai réussi à avoir ça.
ça fonctionne bien mais je ne voudrais pas les fonction de tolerie juste les fonction standard.
et je n’arrive pas à les enlever. Quand j’enlève les fonction tolerie du code dans le bloc 5, il ne fait plus aucune reconnaissance du tout. je ne comprend pas pourquoi
' 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 « J'aime »
je suis dans la menuiserie, c’est uniquement des meubles, donc des panneaux rectangulaire avec des perçages et usinage basic, et j’ai besoin de la reconnaisance pour appliquer mes usinage avec SWOODCAM derrière
1 « J'aime »
Bonjour, en enlevant fwSketchedBend j’ai toujours les fonction de tolerie
dans l’idéal il me faudrais juste ça :
Const optAll As Long = _
fwExtrudeOption + fwVolume + fwRevolve + fwHoles + _
fwChamfils + fwRibs
featApp.RecognizeFeatureAutomatic optAll
sauf que si j’enlève les autres ça ne fonctionne plus il ce passe rien dans le traitement
Bonjour;
Je me demande s’il ne faut pas commencer par ordonner les fonctions à reconnaitre dans les options du feaureWorks.
Quels en sont les réglages chez-toi (ou « chez-vous », je ne sais jamais s’il est plus simple/cordial de vouvoyer ou de tutoyer)…
Bonjour,
j’ai actuellement les même réglage que toi, qui doivent être ceux par défaut je pense