Ok merci pour les précisions.
Et j'étais bien en résolu et je n'ai toujours que 4 pièces sur 7 qui ont un cube de visualisation.
Quand je lance la macro modifiée sur un assemblage plus important cela me crée bien tous les cubes de visualisation, tu n'as pas de pièces surfaciques ? et quelle version de SW ?
Non je n'ai pas de pièces surfaciques et ma version et une 2018
Je viens de refaire des essais et toujours pareil voici mon assemblage si tu veux bien faire des essais
mb_entree.zip
J'ai fait un essai sur un autre assemblage avec 7 pièces et là ça fonctionne, je ne sais pas pourquoi ça ne fonctionne pas avec celui la.
Tu verras peut être quelque chose de ton coté.
Est que tu peux me dire si ce code fonctionne sur des pièces symétrisés ou avec une répétition de composant.
Je vais faire des essais de mon coté pour vérifier, mais ton avis m'interresse
J'obtiens le cube de visualisation sur toutes les pièces de ton assemblages.
J'ai modifié le code comme ce qui suit pour supprimer tout un tas de lignes qui ne servent probablement à rien :
Dim swApp As Object
'Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
'Dim j As Long
'Dim cCnt As Long
Dim Assembly As ModelDoc2
Dim myAsy As AssemblyDoc
Dim myCmps
Dim CmpDoc As ModelDoc2
Dim myCmp As Component2
'Dim tCmp As Component2
Sub main()
'Dim myModelView As Object
Set swApp = Application.SldWorks
'Set Part = swApp.ActiveDoc
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly
myCmps = myAsy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
'cCnt = 0
Set CmpDoc = myCmp.GetModelDoc
'Cfg = myCmp.ReferencedConfiguration
'compte le nombre d'occurences des composants
'For j = 0 To UBound(myCmps)
'Set tCmp = myCmps(j)
'If tCmp.GetSuppression <> 0 Then
'If tCmp.GetModelDoc2 Is CmpDoc Then
'If tCmp.ReferencedConfiguration = Cfg Then
'cCnt = cCnt + 1
'End If
'End If
'End If
'Next j
Document = CmpDoc.GetPathName
'remplissage propriété Type
'If Not CmpDoc.GetPathName Like "*\AppData\*" Then
'T = CmpDoc.CustomInfo("Type")
'Debug.Print T
'If T = "" Then
Set swModel = swApp.ActivateDoc(Document)
'swModel.ForceRebuild ' Reconstruction
'swModel.ShowNamedView2 "*Isométric", -1 ' Vue Isométrique
'swModel.ViewDisplayShaded ' Vue Ombrée
'swModel.ViewZoomtofit2 ' Zoom au mieux
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
'Part.GraphicsRedraw2
'Dim BoundingBox As Object
'Set BoundingBox = Part.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
'Part.ClearSelection2 True
'Enregistre et ferme le document actif en mode silencieux
bRet = CmpDoc.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
swApp.CloseDoc (Document)
'Else
'End If
'End If
End If
Next i
MsgBox "Cube créé", vbExclamation
End Sub
3 « J'aime »
Ok merci pour ton retour, donc je ne comprend pas pourquoi chez moi j'ai soucis, mais j'aurai peut être une explication plus tard.
Merci pour ton épuration du code j'ai également travaillé de mon coté pour supprimer ce qui ne sert pas, mais je vais comparer avec le tiens.
En attendant un grand merci pour ton aide.
Si j'ai un soucis je reviendrai sur le fil en attendant je vais valider ton dernier post
Une autre question qui me travaille, on ouvre toutes les pièces, mais dans un assemblage on peut éditer sans ouvrir et ça fait gagner du temps.
Est il possible de faire la même chose avec cette macro
PS: ton code était bien plus épuré que le mien.
Bonjour,
Oui, c'est possible avec la fonction EditPart2 mais attention à ne pas se mélanger les pinceaux entre les ModelDoc2, AssemblyDoc et Component2.
Cordialement,
Bonjour,
Aurais tu quelque chose qui me permette de comprendre la différence entre ces fonctions?
Car mes recherche sont trop vague pour m'y retrouver.
Bonjour,
Voici un exemple qui doit faire la même chose que la macro déjà fournie :
Option Explicit
Dim swApp As Object
Dim longstatus As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2
Dim nInfo As Long
Sub main()
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAssy = Assembly
myCmps = myAssy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
bRet = myCmp.Select2(False, 0)
bRet = myAssy.EditPart2(True, True, nInfo)
Set swModel = myAssy.GetEditTarget
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
myAssy.EditAssembly
End If
Next i
Assembly.ForceRebuild3 True
MsgBox "Cubes créés", vbExclamation
End Sub
Cordialement,
Bonsoir,
Je viens d'essayer ton code, mais il me fait planter Solidworks 2018.
Sans me mettre aucun éléments de pourquoi il a planter.
Peux tu m'aiguiller?
Bonjour,
Je ne vois aucune raison pour laquelle cette macro te fait planter SW, toutes les fonctions utilisées sont antérieures à SW2018. Mets des MsgBox numérotés entre chaque étape pour voir à quelle fonction il plante ...
Cordialement,
Bonjour,
Voici la ligne qui fait planter Solidworks:
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
Bonjour,
Pour rappel, les macros données ici ne le sont qu'à titre d'exemple et doivent être retravaillées pour à minima ajouter la gestion des erreurs ...
Il te faut donc dans la boucle For rajouter cette gestion des erreurs (voir ICI) et remonter, si tu le souhaites, cette erreur dans l'argument swErrors (voir ICI) de la fonction Save3.
Cordialement,
Excuse moi, mais ce n'est pas la ligne que j'ai cité plus haut qui me fait planter Solidworks, je viens de refaire des test et c'est en fin de compte celle ci:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Pourtant je ne comprend pas car c'est le même code qui fonctionnait dans la macro précèdente.
Et merci pour tes précisions sur Save3, je vais regarder ça.
La réponse est à peu près la même que précédemment : insertion de la gestion des erreurs et relevé du type d'erreur dans la variable longstatus, voir ICI pour le type d'erreur de retour possible.
Bonjour,
J'ai essayer de gérer l'erreur, mais toujours le même problème, c'est a dire Solidworks plante sur la ligne :
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Malgré la gestion d'erreur, Solidworks plante sans ouvrir la msgbox, il y a t il un problème avec le code de ma gestion d'erreur, car la msgbox devrait apparaitre si une erreur est détecté.
Donc il n'y a pas d'erreur détecté, alors qu'est ce qui peut poser problème?
Voici le code avec la gestion d'erreur:
Option Explicit
Dim swApp As Object
Dim longstatus As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2
Dim nInfo As Long
'Public Enum swGlobalBoundingBoxResult_e
'Inherits System.Enum
Sub main()
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAssy = Assembly
'Dim instance As swGlobalBoundingBoxResult_e
myCmps = myAssy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
bRet = myCmp.Select2(False, 0)
bRet = myAssy.EditPart2(True, True, nInfo)
Set swModel = myAssy.GetEditTarget
On Error GoTo errorHandler
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
myAssy.EditAssembly
End If
Next i
Assembly.ForceRebuild3 True
MsgBox "Cubes créés", vbExclamation
Exit Sub
errorHandler:
'indique si l'erreur est detecte
MsgBox "erreur"
End Sub
Bonjour,
Aucun avis sur ma gestion d'erreur est elle correct ou pas du tout?
Merci d'avance
Bonjour @treza88
[HS On]
Petite question par pure curiosité ;-)
A quoi cela te sert d'avoir un cube de visualisation pour une pièce et surtout à quoi cela te sert dans un ASM d'avoir un cube de visualisation pour chaque pièce.
Perso je n'utilise jamais le cube de visualisation.
[HS /Off]
Cordialement