SOLIDWORKS enables the functionality to insert 3D bounding box into the part document. However the edges (segments) of this bonding box cannot be selected and used for the modelling purposes.
This VBA macro creates a bounding box sketch based on SOLIDWORKS 3D bounding box. All segments from the sketch can be selected and used for reference or geometry creation.
Notes
Macro will use existing 3D bonding box or create new one if not exists
Generated bounding box is automatically updated when original bounding box changes (after the rebuild)
It is required for the original bounding box to be visible to update the derived bounding box
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
IfNot swModel IsNothingThenDim swFeat As SldWorks.Feature
Set swFeat = GetBoundingBoxFeature(swModel)
IfNot swFeat IsNothingThenDim swSketch As SldWorks.Sketch
Set swSketch = swFeat.GetSpecificFeature2
Dim vSegs AsVariant
vSegs = swSketch.GetSketchSegments
ConvertSegmentsIntoSketch swModel, vSegs
Else
MsgBox "Failed to get bounding box feature"EndIfElse
MsgBox "Please open document"EndIfEndSubFunction GetBoundingBoxFeature(model As SldWorks.ModelDoc2) As SldWorks.Feature
Dim swFeat As SldWorks.Feature
Set swFeat = FindBoundingBoxFeature(model)
If swFeat IsNothingThenDim status AsLong
model.FeatureManager.InsertGlobalBoundingBox swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, status
Set swFeat = FindBoundingBoxFeature(model)
EndIfSet GetBoundingBoxFeature = swFeat
EndFunctionFunction FindBoundingBoxFeature(model As SldWorks.ModelDoc2) As SldWorks.Feature
Dim swFeat As SldWorks.Feature
Set swFeat = model.FirstFeature
WhileNot swFeat IsNothingIf swFeat.GetTypeName2() = "BoundingBoxProfileFeat"ThenSet FindBoundingBoxFeature = swFeat
ExitFunctionEndIfSet swFeat = swFeat.GetNextFeature
Wend
Set FindBoundingBoxFeature = NothingEndFunctionSub ConvertSegmentsIntoSketch(model As SldWorks.ModelDoc2, segs AsVariant)
If model.SketchManager.ActiveSketch IsNothingThen
model.SketchManager.Insert3DSketch TrueElseIfFalse = model.SketchManager.ActiveSketch.Is3D() Then
Err.Raise vbError, "", "Only 3D sketch is supported"EndIfEndIfDim i AsInteger
model.ClearSelection2 TrueFor i = 0 To UBound(segs)
Dim swSkSeg As SldWorks.SketchSegment
Set swSkSeg = segs(i)
swSkSeg.Select4 True, NothingNext
model.SketchManager.SketchUseEdge3 False, False
model.SketchManager.Insert3DSketch TrueEndSub