Macro boîte englobante

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

 

Sans avoir testé, j'ai trouvé celles-ci sur un site avec des macros en générales très fonctionnelles:

https://www.codestack.net/solidworks-api/geometry/create-selectable-bounding-box/

https://www.codestack.net/solidworks-api/geometry/precise-bounding-box/

 

2 « J'aime »

Merci @sbadenis pour ta réponse.

le premier lien ne fonctionne pas pour moi le InsertGlobalBoundingBox n'est pas disponible sur sw 2016 :/

le deuxième pourrait marcher mais il ne fonctionne que sur une pièce, alors que je le voudrais pour un assemblage.

1 « J'aime »

Deux autres liens alors (daté de 2014) avec un peu de chance:

https://forum.solidworks.com/thread/77234#comment

https://forum.solidworks.com/thread/67196

1 « J'aime »