Hi all
The goal is to automatically create via a VBA macro a name in an assembly, export it to an Excel file whose name will be the part file name + a custom property. Finally, the macro must delete the BOM created.
We don't have My Cad tools - Solidworks Prenium
Hello
It looks a lot like a job ad lol
Otherwise have you started to look at the macro recorder?
Kind regards
Hello
Do you already have a piece of code to show us?
Dimitri.
Hello
Look at the attached macro, normally everything is there (a bit loose and without security checks). Change at least the lines:
TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
Configuration = "Default"
If vPropNames(K) = "CARTOONIST" Then
To put the path to your BOM template, the name of your default configuration in your asms and the name of your custom property you want in the file name.
Kind regards
Thank you for your answer d.roger, the macro works, only small problem, when I put the custom property where you told me the value of the property is not returned in the filename. I have the impression that the line creating the name of the file in the macro, there is no reminder of the property, I tried to add it but the tests are not conclusive on this side.
Hello
You have to replace the 2 lines:
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config. CustomPropertyManager
that retrieve the value requested in the active configuration by:
Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
which will retrieve the value in the "Customize" tab
Kind regards
Perfect by making this modification the macro works as I wanted. Just to improve is it possible to save the spreadsheet in the same folder as the assembly.
Hello
Yes it's possible, you replace the line:
path = About("USERPROFILE") & "\Desktop\" & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & PropertyName & ".xlsx"
by:
path = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & PropertyName & ".xlsx"
Kind regards
Hello
If you also want to give your Excel file a bit of a layout, you can add rows like for example:
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(1).RowHeight = 40
For I = 1 To NumRow - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 20
Next I
For J = 0 To NumCol - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(J + 1).ColumnWidth = 25
xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J
For I = 0 To NumRow - 1
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
Instead of:
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
For I = 0 To NumRow
For J = 0 To NumCol
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
The line:
xlApp.ActiveSheet.Cells(I + 1, J + 1). NumberFormat = "@"
is especially interesting if you have numerical values starting with 0 because it puts the Excel cell in text format and therefore avoids losing the 0 at the beginning.
Kind regards
Hello
First of all, thank you for sharing, it's really great to find information of this quality here!
I'm trying to set up the BOM export macro; Unfortunately I can't get it to work.
I get the message "Runtime error 91 Object variable or block variable with not defined" on the following lines:
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature
Do you have any idea what could be a problem?
Thanks in advance!
Hello
The coincidence is that I'm working on automatic nomenclature and this macro comes just in time. I just have one problem, which is that it retrieves information on first-level parts and not on parts in an assembly or sub-assembly of sub-assembly of assembly etc.
Is there a solution?
Thank you
May the force be with you.
Hello OBI WAN,
Yes there is a solution, you replace the line "BomType = swBomType_TopLevelOnly" with "BomType = swBomType_Indented", this should put the nomenclature in multi-level.
Kind regards
Hello S.Descamps,
Have you correctly replaced the path to your BOM template in the line "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt""?
Or the name of the configuration with a valid configuration in the line "Configuration = "Default""?
Kind regards
Hello
I think it's related to the fact that the file is on the old url of the site. Not secure so the browser freezes (at least that's what happens at home)
Hello;
I don't have any problems downloading it (Firefox?) here it is (again):
insert-bom-asm.swp (77.5 KB)
and if it really doesn't work, here is the " Typescript " version:
Option Explicit
Sub main()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
With xlApp
.Visible = True
Set wbk = .Workbooks.Add
Set sht = wbk.ActiveSheet
End With
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus As Boolean
Dim BomType As Long
Dim Configuration As String
Dim TemplateName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
BomType = swBomType_TopLevelOnly
Configuration = "Défaut"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature
swModel.ForceRebuild3 True
Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
For I = 0 To NumRow
For J = 0 To NumCol
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty As String
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
custPropType = cusPropMgr.GetType2(vPropNames(K))
If vPropNames(K) = "DESSINATEUR" Then
NomProperty = ResolvedValOut
End If
Next K
Dim chemin As String
chemin = Environ("USERPROFILE") & "\Desktop\" & swModel.GetTitle & "-" & NomProperty & ".xls"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Kind regards.
Hello
On this link it works. On the original one on Edge, it generates an error related to the security of the download.
Well, that's it... Are there people who use " Edge "!!
No choice 