Et en modifiant le système de coordonnées X,Y,Z ?
1 « J'aime »
Bonjour
Une astuce peut-être, si une fois généré le cube ne change plus (?) serait de positionner un volume (ou extruder un prolongement temporaire sur le corps) qui délimiterait le coin haut droit sur ta dernière image (donc au max aligné à droite avec le bord droit de la région bleue, et pile aligné en haut avec la pointe supérieure de la région blanche, de sorte à créer un cadre temporaire que va forcer ce rajout.
Ça marche avec n’importe quel coin par ailleurs.
1 « J'aime »
Petit message de prévention en passant :
« Boire ou construire, il faut choisir ! » 
4 « J'aime »
Bonjour @a_eriaud
J’ai cette macro qui fonctionne bien en s’orientant suivant XYZ :
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swPart As SldWorks.PartDoc
Set swPart = swApp.ActiveDoc
If Not swPart Is Nothing Then
Dim vBBox As Variant
vBBox = GetPreciseBoundingBox(swPart)
DrawBox swPart, CDbl(vBBox(0)), CDbl(vBBox(1)), CDbl(vBBox(2)), CDbl(vBBox(3)), CDbl(vBBox(4)), CDbl(vBBox(5))
Debug.Print "Width: " & CDbl(vBBox(3)) - CDbl(vBBox(0))
Debug.Print "Length: " & CDbl(vBBox(5)) - CDbl(vBBox(2))
Debug.Print "Height: " & CDbl(vBBox(4)) - CDbl(vBBox(1))
Else
MsgBox "Please open part"
End If
End Sub
Function GetPreciseBoundingBox(part As SldWorks.PartDoc) As Variant
Dim dBox(5) As Double
Dim vBodies As Variant
vBodies = part.GetBodies2(swBodyType_e.swSolidBody, True)
Dim minX As Double
Dim minY As Double
Dim minZ As Double
Dim maxX As Double
Dim maxY As Double
Dim maxZ As Double
If Not IsEmpty(vBodies) Then
Dim i As Integer
For i = 0 To UBound(vBodies)
Dim swBody As SldWorks.Body2
Set swBody = vBodies(i)
Dim x As Double
Dim y As Double
Dim z As Double
swBody.GetExtremePoint 1, 0, 0, x, y, z
If i = 0 Or x > maxX Then
maxX = x
End If
swBody.GetExtremePoint -1, 0, 0, x, y, z
If i = 0 Or x < minX Then
minX = x
End If
swBody.GetExtremePoint 0, 1, 0, x, y, z
If i = 0 Or y > maxY Then
maxY = y
End If
swBody.GetExtremePoint 0, -1, 0, x, y, z
If i = 0 Or y < minY Then
minY = y
End If
swBody.GetExtremePoint 0, 0, 1, x, y, z
If i = 0 Or z > maxZ Then
maxZ = z
End If
swBody.GetExtremePoint 0, 0, -1, x, y, z
If i = 0 Or z < minZ Then
minZ = z
End If
Next
End If
dBox(0) = minX: dBox(1) = minY: dBox(2) = minZ
dBox(3) = maxX: dBox(4) = maxY: dBox(5) = maxZ
GetPreciseBoundingBox = dBox
End Function
Sub DrawBox(model As SldWorks.ModelDoc2, minX As Double, minY As Double, minZ As Double, maxX As Double, maxY As Double, maxZ As Double)
model.ClearSelection2 True
model.SketchManager.Insert3DSketch True
model.SketchManager.AddToDB = True
model.SketchManager.CreateLine maxX, minY, minZ, maxX, minY, maxZ
model.SketchManager.CreateLine maxX, minY, maxZ, minX, minY, maxZ
model.SketchManager.CreateLine minX, minY, maxZ, minX, minY, minZ
model.SketchManager.CreateLine minX, minY, minZ, maxX, minY, minZ
model.SketchManager.CreateLine maxX, maxY, minZ, maxX, maxY, maxZ
model.SketchManager.CreateLine maxX, maxY, maxZ, minX, maxY, maxZ
model.SketchManager.CreateLine minX, maxY, maxZ, minX, maxY, minZ
model.SketchManager.CreateLine minX, maxY, minZ, maxX, maxY, minZ
model.SketchManager.CreateLine minX, minY, minZ, minX, maxY, minZ
model.SketchManager.CreateLine minX, minY, maxZ, minX, maxY, maxZ
model.SketchManager.CreateLine maxX, minY, minZ, maxX, maxY, minZ
model.SketchManager.CreateLine maxX, minY, maxZ, maxX, maxY, maxZ
model.SketchManager.AddToDB = False
model.SketchManager.Insert3DSketch True
End Sub
Mes assemblages sont toujours parrallèles au plans de dessus, donc normaux à Y, mais pas forcément parallèle à X (ou Z).
Je ne sais pas si des fonctions de macro VBA permettraient en sélectionnant à l’avance la face qui serait la référence d’orientation de générer une esquisse 3D bien orientée…
Si quelqu’un a une idée de la façon de faire cela en macro, je suis preneur 
Bonjour,
Effectivement, il y a peut-être un truc à faire avec cette macro…
Mais je ne m’y connais pas assez pour me lancer…
Il faudrait, je pense, creuser du côté de la fonction « GetExtremePoint » pour trouver le point extrême en restant parallèle à un plan.
C’est juste une idée…
Je pense que sur ce forum il y a des pro de la macro, certain m’ont déjà bien aidé…
Bon week-end par avance.
2 « J'aime »
Bonjour @MLG ,
Si on retient l’idée d’un « cube enveloppe » (en fait un parallélépipède rectangle), les trois plans générateurs sont perpendiculaires. Le premier étant choisi, il suffit ensuite de donner une direction dans ce plan pour que le trièdre soit complètement contraint.
En partant de la macro Codestack proposée par @MLG et destinée à une pièce, on se dit qu’il suffit de l’adapter à un assemblage en balayant les pièces de l’arbre de construction et en forçant les directions de projections.
Simple en apparence, mais les quelques instants envisagés se transforment en heures. Heureusement, la météo était maussade…
Le résultat est disponible dans la macro jointe. Mode d’emploi :
- un assemblage doit être ouvert dans SolidWorks,
- un plan et une direction (arête rectiligne ou segment d’esquisse) sont sélectionnés dans cet ordre dans la zone graphique,
- la macro est exécutée.
Résultats :
- le cube enveloppe est affiché sous la forme d’une esquisse 3D dans l’assemblage,
- les longueurs des arêtes du cube sont indiquées dans un UserForm.
Faiblesse par rapport au « cube de visualisation » de SolidWorks : le cube enveloppe est figé sur la géométrie au moment de sa création. Une évolution ultérieure des formes de l’assemblage ne sera pas prise en compte.
Comme toujours, macro sans garde-fous, sans garantie de résultat, à tester en particulier sur des gros assemblages.
Cordialement.
Macro modifiée, à télécharger plus bas…
5 « J'aime »
Bonjour @m_blt
J’ai parcouru le code et il y a du taf !!! BRAVO 
Par contre, j’ai testé sur un de mes assemblages, mais rien ne se passe.
Aucun message d’erreur, même si je le force en lançant la macro sur une pièce.
Ce qui, d’après ce que j’ai pu voir dans le code, devrait me générer une fenêtre d’avertissement.
Une idée de ce qu’il faut faire ?
1 « J'aime »
En lançant le sub main depuis l’éditeur via F8, il m’affiche une erreur projet ou bibliothèque manquante:
Et en regardant l’erreur je comprends mieux bibliothèque manquante (SW2023)
Peut-être que tu as le même soucis. Quel version de SW tu as?
@m_blt je voulais jeter un œil par curiosité et intérêt puisqu’en général tes macros me subjugue!
Edit: en décochant ce qui est manquant et en cochant les3 bibliothèque version 2020 cela fonctionne!
Une fois de plus je suis épaté par ce code:
3 « J'aime »
La macro ne fonctionne pas sur une pièce puisqu’elle parcourt l’arbre de construction d’un assemblage. Déjà là, vous devriez avoir ce message:
Personnellement, j’ai testé la macro sur plusieurs assemblages, le plus « lourd » comportant 278 pièces, sans constater d’anomalie. Si vous exécutez la macro sans avoir sélectionné d’objets, vous devriez au moins voir s’afficher la fiche UserForm.
Je confirme le soupçon de @sbadenis : le dysfonctionnement est peut-être dû à l’absence de certaines références aux objets de VBA. Voici celles que j’utilise avec la version 2023 de SolidWorks:
Vérifiez également que l’affichage des esquisses est bien activé dans l’assemblage, sait-on jamais…
Autre piste: la macro a été écrite avec SW 2023. Peut-être y a-t-il une fonction inexistante si vous utilisez une version plus ancienne. Même si un message d’erreur devrait s’afficher… A en juger par l’illustration de son message, @sbadenis l’a fait fonctionner avec une version 2020
L’assemblage sur lequel vous avez testé la macro aurait-il une particularité qui empêche son bon fonctionnement ? Il faudrait partager un de vos assemblages et préciser quelle version de SW vous utilisez.
2 « J'aime »
@m_blt
Quand je vois ce travail je me dis qu’il était plus que temps que je prenne la tangente qui est parallèle au plan. D’ailleurs un bon plan est toujours apprécié.
C dlt
4 « J'aime »
J’ai appliqué les modifications des références en cochant les 2022 pour ma version :
Et la macro a bien fonctionné, c’est TOP @m_blt 
:
J’ai juste changé les ptLoc de la longueur et profondeur du cube qui pour moi, étaient inversés (ptLoc(4) et (1)), ainsi que la précision afin de ne pas avoir de décimale:
UserForm1.Label3.Caption = "Longueur du cube : " & Format(longueur(ptLoc(0), ptLoc(4)), "#####0")
UserForm1.Label4.Caption = "Largeur du cube : " & Format(longueur(ptLoc(0), ptLoc(2)), "#####0")
UserForm1.Label5.Caption = "Profondeur du cube : " & Format(longueur(ptLoc(0), ptLoc(1)), "#####0")
C’est NICKEL.
Par contre j’aimerai récupérer ces valeurs et les associer à des variables dans touts les configs mais je ne sais pas où et comment (sub, function …) je dois insérer cela :
Dim i As Integer
Dim tConfig() As String
Dim swErrors As Long
Dim swWarnings As Long
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute un propriété personnalisée "DIM-Lo"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-Lo")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-Lo", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(4)), "#####0") & Chr(34))
'ajoute un propriété personnalisée "DIM-La"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-La")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-La", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(2)), "#####0") & Chr(34))
'ajoute un propriété personnalisée "DIM-Ha"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-Ha")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-Ha", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(1)), "#####0") & Chr(34))
Next i
Est ce que vous auriez une piste pour moi ?
Bonjour @m_blt Bravo et merci pour ta macro. Juste une petite suggestion ; préciser les axes xyz des dimensions indiquées, entre parenthèses par exemple, car largeur longueur profondeur c’est pour le moins relatif.
1 « J'aime »
Bonjour à tous,
Une dernière (?) réponse…
- les trois dimensions du cube enveloppe sont inscrites en propriétés dans toutes les configs de l’assemblage;
- pour répondre au souhait de @Sylk
, j’ai ajouté un repère local à l’origine du cube, dont les axes sont alignés sur les arêtes. De façon à identifier les directions X, Y et Z.
Il me semble que pour @MLG, il s’agit dans l’ordre de la hauteur (X), de la longueur (Y) et de la profondeur (Z).
Ordre modifiable facilement au niveau des lignes 322 à 334.
Une petite image pour situer les sommets du cube.
Cordialement.
CubeVisuAssembly.swp (223 Ko)
2 « J'aime »
Merci encore @m_blt
Ca fonctionne très bien 
J’ai une différence de précision des résultats entre la boite de dialogue et les variables dans les propriétés (F8) :
la précision est à l’unité (pas de décimale) dans la boite de dialogue
La précision est de 6 décimales
J’ai pourtant appliqué le même FORMAT dans le code entre ce qui s’affiche dans la boite de dialogue et dans les propriétés (F8) :
Dim valLONG As Variant
Dim valLARG As Variant
Dim valHAUT As Variant
Set ptLoc(0) = creationPt(min(0), min(1), min(2))
Set ptLoc(1) = creationPt(max(0), min(1), min(2))
Set ptLoc(2) = creationPt(min(0), max(1), min(2))
Set ptLoc(3) = creationPt(max(0), max(1), min(2))
Set ptLoc(4) = creationPt(min(0), min(1), max(2))
Set ptLoc(5) = creationPt(max(0), min(1), max(2))
Set ptLoc(6) = creationPt(min(0), max(1), max(2))
Set ptLoc(7) = creationPt(max(0), max(1), max(2))
For iPt = 0 To 7
Set ptLoc(iPt) = ptLoc(iPt).MultiplyTransform(RgToCube)
Next iPt
TraceBox ptLoc
lgAreteCube(0) = CalculLongueur(ptLoc(0), ptLoc(1))
lgAreteCube(1) = CalculLongueur(ptLoc(0), ptLoc(2))
lgAreteCube(2) = CalculLongueur(ptLoc(0), ptLoc(4))
UserForm1.Label3.Caption = "DIM-Lo : " & Format((lgAreteCube(2) / 10), "#####0")
UserForm1.Label4.Caption = "DIM-La : " & Format((lgAreteCube(0) / 10), "#####0")
UserForm1.Label5.Caption = "DIM-Ha : " & Format((lgAreteCube(1) / 10), "#####0")
UserForm1.CommandButton3.Enabled = True
valLONG = (Format((lgAreteCube(2) / 10), "#####0"))
valLARG = (Format((lgAreteCube(0) / 10), "#####0"))
valHAUT = (Format((lgAreteCube(1) / 10), "#####0"))
swConfNames = swModel.GetConfigurationNames ' Liste des noms de configurations
For iPt = LBound(swConfNames) To UBound(swConfNames) ' Boucle sur les configs
Set swCstPropMgr = swModel.Extension.CustomPropertyManager(swConfNames(iPt))
swCstPropMgr.Add3 "DIM-Lo", swCustomInfoDouble, valLONG, swCustomPropertyReplaceValue
swCstPropMgr.Add3 "DIM-La", swCustomInfoDouble, valLARG, swCustomPropertyReplaceValue
swCstPropMgr.Add3 "DIM-Ha", swCustomInfoDouble, valHAUT, swCustomPropertyReplaceValue
Next iPt
End Sub
Et j’ai testé en modifiant les décimales dans mes paramêtres d’unités de SW, mais ça ne change rien.
Est ce que vous avez une idée d’où vient le soucis ?
1 « J'aime »
Puisque vous ne souhaitez pas de décimales, le plus simple consiste à convertir la variable lgAreteCube de type Double en Integer dans l’instruction de génération des propriétés.
En remplaçant la ligne :
swCstPropMgr.Add3 "CubEnvLongueurY", swCustomInfoNumber, CInt(lgAreteCube(1)), swCustomPropertyReplaceValue
par celle-ci :
swCstPropMgr.Add3 "CubEnvLongueurY", swCustomInfoNumber, CInt(lgAreteCube(1)), swCustomPropertyReplaceValue
A adapter selon vos notations.
Si vous recherchez un format plus fouillé, il faudra en passer par des chaînes de caractères…
2 « J'aime »
Merci encore @m_blt
cela fonctionne très bien.
Je cherche depuis hier sur Codestack si il y a moyen de nommer l’esquisse 3D lors de sa réalisation, ou de récupérer le nom de la derniere esquisse créée dans l’arbre.
Mais je n’ai rien trouvé là dessus.
J’aurais besoin de cela pour ajouter la suppression de l’esquisse 3D à la fin de la macro pour remettre à propre nos assemblage une fois les variables récupérées.
Quand je regarde ce code généré dans Solidworks avec une première suppression d’esquisse 2D puis une suppression d’esquisse 3D, il n’y pas de différence de synthaxe à part le nom de la fonction. Que ce soit 2D ou 3D, c’est « SKETCH » qui apparait :
boolstatus = Part.Extension.SelectByID2("Esquisse3D1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete
boolstatus = Part.Extension.SelectByID2("Esquisse1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete
Savez vous comment procéder ?
Merci d’avance
1 « J'aime »
Bonjour,
Sur la fiche UserForm1, il y a un bouton [Effacer] qui supprime l’esquisse 3D et le repère associé au cube. A condition qu’il s’agisse des deux dernières fonctions de l’arbre, donc que rien ne soit ajouté après création du cube.
Quant à récupérer le nom d’une esquisse, la méthode « Name » fait partie de la classe « ISketch » de l’API (« swSketch.Name », cf. ligne 377).
Mais si vous avez une variable pointant sur l’esquisse, comme par exemple à la ligne 363 (« Set swSketch = swModel.SketchManager.ActiveSketch »), la méthode « Select4() » permet la sélection sans avoir à rechercher son nom, par exemple :
« ok = swSketch.Select4(False, Nothing) »
Membres sans doute hérités, ils ne sont pas documentés dans l’aide de la classe « ISketch », mais le sont dans d’autres…
1 « J'aime »
Bonjour @m_blt
Merci une fois de plus pour ton retour.
Je n’avais pas percuté pour le bouton EFFACER effectivement.
Je vais regarder cela de plus prêt pour voir à quel moment ça agit par rapport aux renseignement des variables que j’ai ajouté … et pour enrichir ma pauvreté intellectuelle en VBA 
.
D’ailleurs, en VBA j’ai bricolé cela ce matin…
Un macro qui récupère le nom de la derniere fonction afin de la supprimer.
Comme il y a une esquisse 3D et un trièdre, je double les lignes de commande pour supprimer les 2 fonctions.
Je sais, c’est archaïque 
Il y a surement moyen de faire plus simple j’imagine …
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssembly As SldWorks.AssemblyDoc
Dim swFeatureName As SldWorks.Feature
Sub SuppressionDeuxDernieresFonctions()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
' Vérifie que le document SW est ouvert
If swDoc Is Nothing Then
MsgBox "Aucun document Solidworks ouvert"
Exit Sub
End If
Set swAssembly = swDoc
'''Première passe pour supprimer le trièdre
'Attribution nom dernière fonction
Set swFeatureName = swDoc.Extension.GetLastFeatureAdded
'Vérifie la selection de la fonction
If swFeatureName Is Nothing Then
MsgBox "Sélection fonction impossible"
swDoc.ClearSelection2 True
Exit Sub
End If
'Selection du nom
swFeatureName.Select True
'Suppression de la fonction
swDoc.EditDelete
'''Deuxième passe pour supprimer l'esquisse 3D
'Attribution nom dernière fonction
Set swFeatureName = swDoc.Extension.GetLastFeatureAdded
'Vérifie la selection de la fonction
If swFeatureName Is Nothing Then
MsgBox "Selection fonction Impossible"
swDoc.ClearSelection2 True
Exit Sub
End If
'Selection du nom
swFeatureName.Select True
'Suppression de la fonction
swDoc.EditDelete
End Sub
1 « J'aime »
Bonjour @m_blt
j’ai une petite question concernant la définition du tracé de la boite.
J’ai quelques cas ou elle ne se cale pas totalement au max de ce qui devrait être. Notamment sur des pièces rondes comportant des congés :
J’ai le cas sur les 2 pièces à droite et à gauche :
Mais je n’ai pas le cas sur la pièce du haut :
A quel endroit du code puis-je intervenir afin d’obtenir une bonne tangence ?
En tous cas, la macro fonctionne super bien.
J’y ai apporté mes arrangements et des fonctions en plus et c’est TOP.
Merci beaucoup pour l’aide apportée.
Merci d’avance.
Bonjour,
Difficile de se prononcer sur l’origine du problème que vous soulevez. Quelques remarques:
-
Quelle est l’importance de l’erreur, comparée aux dimensions générales de l’assemblage (en mm par exemple) ?.
-
Dans la mesure où le défaut observé nécessite un zoom important, l’affichage est peut-être en cause…
-
C’est la méthode « GetExtremePoint() » qui détermine la limite extérieure pour chaque pièce. Il s’agit d’un calcul numérique interne aux API de SolidWorks. Est-il rigoureux ? Comme tout calcul numérique, il utilise un critère de qualité pour valider sa recherche, critère inconnu de l’utilisateur.
Sur ce point, commentaire de l’aide SolidWorks à propos de la fonction « GetBodyBox » qui utilise apparemment la méthode « GetExtremePoint » :
IMPORTANT : Les valeurs renvoyées sont approximatives et ne doivent pas être utilisées à des fins de comparaison ou de calcul. De plus, la boîte englobante peut varier après la reconstruction du modèle.
Les contours des « nuages » visibles sur les copies d’écran semblent basés sur des splines. Serait-ce l’origine du pb ?
- Les seuls calculs à l’intérieur de la macro sont des changements de repères qui utilisent les fonctions vectorielles et matricielles de l’API. Je ne vois pas comment ils peuvent générer le défaut.
Pour conclure: je ne suis pas en mesure d’identifier l’origine du souci. Pouvez-vous partager l’exemple qui pose problème ? Même dégradé, ou par message privé…
Cordialement.
4 « J'aime »