SolidWorks 3D CAD products FAQ

'<><><><><><><><><><><><><><><><><><><><><><><><><>
' AutoFit BOM Utility - Dimensional Solutions, Inc.
'<><><><><><><><><><><><><><><><><><><><><><><><><>
Option Explicit

Dim swApp As Object
Dim swPart As Object
Dim swView As Object
Dim swBOM As Object
Const swMbQuestion = 3
Const swMbYesNo = 5
Const swMbHitNo = 3

Sub Main()
    Dim xl As Object, xlsh As Object
    Dim ret, s1 As String, retval As Long
    
    'Attach to SolidWorks
    On Error Resume Next
    Set swApp = GetObject(, &quot;SldWorks.Application&quot;)
    If Err.Number > 0 Then
        MsgBox &quot;Can not Find SldWorks.Application&quot; & vbCrLf & _
               &quot;ErrNo: &quot; & Err.Number & &quot;  ErrMsg: &quot; & Err.Description _
               , vbOKOnly, &quot;Error in FitBOM()&quot;
        Err.Clear
        GoTo CleanUp
    End If
    On Error GoTo ErrorFB

    'User must zoom into the BOM. For some reason, the columns
    'may not AutoFit when zoomed out too much.
    s1 = &quot;Are you zoomed into the BOM?&quot; & vbCrLf & _
         &quot;You need to select the BOM, then&quot; & vbCrLf & _
         &quot;click the Zoom To Selection button.&quot;
    retval = swApp.SendMsgToUser2(s1, swMbQuestion, swMbYesNo)
    If retval = swMbHitNo Then
        Exit Sub
    End If
    
    Set swPart = swApp.ActiveDoc
    Set swView = swPart.GetFirstView
    Set swBOM = swView.GetBomTable

    'Find the BOM - must find the view that contains the BOM
    Do While swBOM Is Nothing And Not swView Is Nothing
        Set swView = swView.GetNextView
        Set swBOM = swView.GetBomTable
    Loop
    
    'Could not find a BOM
    If swBOM Is Nothing Then
        swApp.SendMsgToUser &quot;Can NOT find the BOM on the current drawing!&quot;
        GoTo CleanUp
    End If
    
    'Activate the BOM
    ret = swBOM.Attach3
    If ret = False Then
        swApp.SendMsgToUser &quot;Error Attaching to BOM&quot;
        GoTo CleanUp
    End If
    
    'Attach Using Excel API - Less Restrictive than the SolidWorks API
    Set xl = GetObject(, &quot;Excel.Application&quot;)
    If xl Is Nothing Then
        swApp.SendMsgToUser &quot;Could Not Attach to Active Excel Object&quot;
        GoTo CleanUp
    End If
    Set xlsh = xl.ActiveSheet         'Get handle to the active sheet in Excel
    
    'AutoFit the columns to the text - avoids cutting off text.
    xlsh.Columns(&quot;A:I&quot;).AutoFit     'Columns to AutoFit
    
    'Detach from the BOM
    'For some reason, this method will not display the
    'updated BOM, although the changes are saved.
    'Make the user detach manually.
    'swBOM.Detach  '(This does not show the updated BOM although the changes are saved)
    'swPart.EditRebuild

EndOfFit:
    swApp.SendMsgToUser &quot;Done! Please click somewhere else&quot; & vbCrLf & _
           &quot;on the sheet to deactivate the BOM.&quot;
CleanUp:
    'Clean Up
    Set xlsh = Nothing
    Set xl = Nothing
    Set swBOM = Nothing
    Set swView = Nothing
    Set swPart = Nothing
    Set swApp = Nothing
    Exit Sub
ErrorFB:
    MsgBox &quot;Error in FitBOM() Utility&quot; & vbCrLf & Err.Description
    Err.Clear
End Sub