This macro will AutoFit a BOM to the data contained within.
NOTES:
1. The user must zoom in to the BOM or the AutoFit will not work properly.
2. If you are linking dimensions in your BOM, you will need to be running SW 2001 SP9 or greater. Before this, the entire reference string was displayed in the cell. Since this macro AutoFits to the data in Excel, it would not fit to the display values.
3. This macro fits columns A through I. Just change the AutoFit range to suit your needs.
4. To incorporate this, just create a new macro and paste this code. You can define one of the macro buttons to run this routine.
5. Once you have the macro file opened, go to Tools > References and add the Microsoft Excel Object Library.
Code:
'<><><><><><><><><><><><><><><><><><><><><><><><><>
' 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(, "SldWorks.Application")
If Err.Number > 0 Then
MsgBox "Can not Find SldWorks.Application" & vbCrLf & _
"ErrNo: " & Err.Number & " ErrMsg: " & Err.Description _
, vbOKOnly, "Error in FitBOM()"
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 = "Are you zoomed into the BOM?" & vbCrLf & _
"You need to select the BOM, then" & vbCrLf & _
"click the Zoom To Selection button."
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 "Can NOT find the BOM on the current drawing!"
GoTo CleanUp
End If
'Activate the BOM
ret = swBOM.Attach3
If ret = False Then
swApp.SendMsgToUser "Error Attaching to BOM"
GoTo CleanUp
End If
'Attach Using Excel API - Less Restrictive than the SolidWorks API
Set xl = GetObject(, "Excel.Application")
If xl Is Nothing Then
swApp.SendMsgToUser "Could Not Attach to Active Excel Object"
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("A:I").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 "Done! Please click somewhere else" & vbCrLf & _
"on the sheet to deactivate the BOM."
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 "Error in FitBOM() Utility" & vbCrLf & Err.Description
Err.Clear
End Sub
