Witam, szukam makra do wykonania obwiedni w szkicu 3D dla części lub złożenia.
Po przeszukaniu i przejrzeniu kilku forów w końcu udało mi się znaleźć to, czego potrzebowałem.
Problem polega na tym, że makro nie działa cały czas, gdy są zaokrąglone rogi, pozycja szkicu nie jest dobra. Czy masz rozwiązanie, które sprawi, że to zadziała w każdym przypadku?
Oto kod:
'--------------------------------------------
' 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