Bonjour, je suis à la recherche d'une macro pour faire une boîte englobante dans une esquisse 3D pour une pièce ou un assemblage.
Après avoir cherché et parcouru plusieurs forum j'ai enfin réussi à trouver ce qu'il me fallait.
Le problème c'est que la macro ne fonctionne pas tout le temps, quand il y a des coins arrondi, la position de l'esquisse n'est pas bonne. Est-ce vous auriez une solution pour que celà fonctionne dans n'importe quel cas ?
voici le code :
'--------------------------------------------
' Preconditions:
' 1. Open an assembly or part document.
' 2. Run the macro.
'
' Postconditions:
' 1. Adds a 3D sketch to the assembly or part showing the bounding box.
' 2. Shows results on a message box.
'
' NOTE: The bounding box is approximated and oriented
' with the model coordinate system.
' Remember to delete the bounding box 3D sketch if not needed
'----------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swPart As SldWorks.PartDoc
Dim vBox As Variant
Dim X_max As Double
Dim X_min As Double
Dim Y_max As Double
Dim Y_min As Double
Dim Z_max As Double
Dim Z_min As Double
Dim D_X As Double
Dim D_Y As Double
Dim D_Z As Double
Dim Ret As Integer
Dim Delta_X As String
Dim Delta_Y As String
Dim Delta_Z As String
Dim Header As String
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchPt(8) As SldWorks.SketchPoint
Dim swSketchSeg(12) As SldWorks.SketchSegment
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
If swModel.GetType < 1 Or swModel.GetType > 2 Then
MsgBox ("Le document actif doit être un assemblage ou une pièce")
Exit Sub
End If
If swModel.GetType = 2 Then
Set swAssy = swModel
vBox = swAssy.GetBox(0)
End If
If swModel.GetType = 1 Then
Set swPart = swModel
vBox = swPart.GetPartBox(True)
End If
' Initialize values
X_max = vBox(3)
X_min = vBox(0)
Y_max = vBox(4)
Y_min = vBox(1)
Z_max = vBox(5)
Z_min = vBox(2)
' Calculate Bounding Box sizes
D_X = X_max - X_min
D_Y = Y_max - Y_min
D_Z = Z_max - Z_min
Debug.Print "Assembly Bounding Box (" + swModel.GetPathName + ") = "
Debug.Print " (" + Str(X_min * 1000#) + "," + Str(Y_min * 1000#) + "," + Str(Z_min * 1000#) + ") mm"
Debug.Print " (" + Str(X_max * 1000#) + "," + Str(Y_max * 1000#) + "," + Str(Z_max * 1000#) + ") mm"
Set swSketchMgr = swModel.SketchManager
swSketchMgr.Insert3DSketch True
swSketchMgr.AddToDB = True
' Draw points at each corner of bounding box
Set swSketchPt(0) = swSketchMgr.CreatePoint(X_min, Y_min, Z_min)
Set swSketchPt(1) = swSketchMgr.CreatePoint(X_min, Y_min, Z_max)
Set swSketchPt(2) = swSketchMgr.CreatePoint(X_min, Y_max, Z_min)
Set swSketchPt(3) = swSketchMgr.CreatePoint(X_min, Y_max, Z_max)
Set swSketchPt(4) = swSketchMgr.CreatePoint(X_max, Y_min, Z_min)
Set swSketchPt(5) = swSketchMgr.CreatePoint(X_max, Y_min, Z_max)
Set swSketchPt(6) = swSketchMgr.CreatePoint(X_max, Y_max, Z_min)
Set swSketchPt(7) = swSketchMgr.CreatePoint(X_max, Y_max, Z_max)
' Draw bounding box
Set swSketchSeg(0) = swSketchMgr.CreateLine(X_min, Y_min, Z_min, X_max, Y_min, Z_min)
Set swSketchSeg(1) = swSketchMgr.CreateLine(X_max, Y_min, Z_min, X_max, Y_min, Z_max)
Set swSketchSeg(2) = swSketchMgr.CreateLine(X_max, Y_min, Z_max, X_min, Y_min, Z_max)
Set swSketchSeg(3) = swSketchMgr.CreateLine(X_min, Y_min, Z_max, X_min, Y_min, Z_min)
Set swSketchSeg(4) = swSketchMgr.CreateLine(X_min, Y_min, Z_min, X_min, Y_max, Z_min)
Set swSketchSeg(5) = swSketchMgr.CreateLine(X_min, Y_min, Z_max, X_min, Y_max, Z_max)
Set swSketchSeg(6) = swSketchMgr.CreateLine(X_max, Y_min, Z_min, X_max, Y_max, Z_min)
Set swSketchSeg(7) = swSketchMgr.CreateLine(X_max, Y_min, Z_max, X_max, Y_max, Z_max)
Set swSketchSeg(8) = swSketchMgr.CreateLine(X_min, Y_max, Z_min, X_max, Y_max, Z_min)
Set swSketchSeg(9) = swSketchMgr.CreateLine(X_max, Y_max, Z_min, X_max, Y_max, Z_max)
Set swSketchSeg(10) = swSketchMgr.CreateLine(X_max, Y_max, Z_max, X_min, Y_max, Z_max)
Set swSketchSeg(11) = swSketchMgr.CreateLine(X_min, Y_max, Z_max, X_min, Y_max, Z_min)
swSketchMgr.AddToDB = False
swSketchMgr.Insert3DSketch True
' Show box sizes
Header = "Nom du fichier : " + Chr(13) + swModel.GetPathName + Chr(13) + Chr(13) + "Tailles de la boîte englobante (X, Y, Z) = "
Delta_X = Str(Int(Abs(D_X) * 1000))
Delta_Y = Str(Int(Abs(D_Y) * 1000))
Delta_Z = Str(Int(Abs(D_Z) * 1000))
Ret = MsgBox(Header + Delta_X + " x " + Delta_Y + " x " + Delta_Z + " mm" + Chr(13) + Chr(13) + "Supprimer l'esquisse 3D de la boîte englobante du modèle si vous n'en avez pas besoin.", vbOKOnly, "Model Bounding Box")
End Sub