This macro works well and I thank you for that. However, I have two small remarks:
it does not take into account whether or not parts are defined as "Excluded from the BOM". All the documents stand out in the Excel table.
For mechanically welded parts, the macro exports each welded body as a part in its own right when these bodies should be excluded from the nomenclature (well, in my case).
Is it possible to solve these 2 small problems by an additional piece of code?
If it is not possible to hide them, perhaps it is possible to add a column to the Excel file with a property "Excluded from BOM" and as a value on each YES or NO row.
I don't know which macro you started from precisely and what modifications you made but it's still weird that parts excluded from the nomenclature appear in this said nomenclature (unless they are excluded from the nomenclature in a configuration but not in the one from which you get the nomenclature).
For mechanically welded parts, this is probably due to the swBomType chosen for the creation of the BOM:
- "Indented": all levels including the profiles of the mechanically welded.
- "TopLevelOnly": only the first level so not the profiles of the mechanically welded.
On this link there seems to me all the useful information.
Thank you for your answer. Yes, I had seen the topic of discussion you mention. If I change the swBomType to "TopLevelOnly", I actually only have the 1st level, so I'm missing all the sublevels. If I put the swBomType in "Indented", it goes down to the body of the mechanically welded parts, which is too low a floor.
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 = "C:\Users\vousm\Documents travail\Config_Sw\Table nomenclature\table_nomenclature.sldbomtbt"
'BomType = swBomType_Indented
BomType = swBomType_TopLevelOnly
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
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
'mise en forme
For I = 1 To NumRow - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 15
Next I
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(1).ColumnWidth = 6
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(2).ColumnWidth = 17
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(3).ColumnWidth = 4
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(4).ColumnWidth = 34
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(5).ColumnWidth = 34
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(6).ColumnWidth = 4
For I = 0 To NumRow - 1
For J = 0 To NumCol - 1
If J <> 5 Then 'cas de la colonne Qté
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
End If
xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
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
Dim chemin As String
chemin = "C:\temp\BOS4.xlsx"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
How can we do it then? Thank you for your feedback,
In this case it is possible to set swBomType to "Indented" and retrieve the component for each row of the BOM using the Getcomponents2 function to decide whether or not to insert it in the Excel file, you may have to hang on to the ModelDoc2 object for each component to analyze it, this can be done using the GetModelDoc2 function.
Wow, we're going to reach the limits of my programming skills.
I have the impression that everything comes down to the line "Set swBOMAnnotation = swModelDocExt.InsertBomTable3... " where the nomenclature is created. Already here, the bodies of the welded part appear. Attached, the document in question. Since SW, by manually changing the parameters of the nomenclature, I can't hide these bodies. Even unchecking the "Detailed list of welded parts" box doesn't help. What to do in this case?
Here is a possible solution, I started from the macro I had already made so it's to be re-adapted to your case but the principle is: for each line of the nomenclature I get the ModelDoc to analyze it and see if it's a welded construction, if it's the case and that this ModelDoc2 is the same as the previous line then I don't have to worry about it. does not take this into account for the export to Excel. I did my tests on one of my assemblies because I can't open the holder (future version).
Kind regards
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_Indented
Configuration = "Défaut"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature
swModel.ForceRebuild3 True
Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long
Dim H As Long
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
H = 1
For I = 0 To NumRow - 1
Dim vPtArr As Variant
Dim swcomp As Component2
Dim comp As ModelDoc2
Dim Titre As String
Dim newTitre As String
Dim FeatName As String
Dim printOk As Boolean
printOk = False
FeatName = ""
vPtArr = swBOMAnnotation.GetComponents2(I, Configuration)
If (Not IsEmpty(vPtArr)) Then
Set swcomp = vPtArr(0)
Set comp = swcomp.GetModelDoc2
newTitre = comp.GetTitle
Dim swfeat As Feature
Set swfeat = comp.FirstFeature
Do While Not swfeat Is Nothing
If swfeat.Name = "Construction soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
End If
If FeatName = "Construction soudée" Then
If Not Titre = newTitre Then
printOk = True
End If
Else
printOk = True
End If
If printOk = True Then
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(H, J + 1).NumberFormat = "@"
xlApp.ActiveSheet.Cells(H, J + 1).VerticalAlignment = 2
sht.Cells(H, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
H = H + 1
End If
Titre = newTitre
Next I
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True
Dim chemin As String
chemin = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & ".xlsx"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Thank you for taking the time to look at my problem. So I modified my macro with your recommendations. If I understand correctly, the macro goes through all the construction lines of the part and checks if it finds a "welded construction" text. Everything happens in this loop:
Do While Not swfeat Is Nothing
Debug.Print swfeat.Name
If swfeat.Name = "Construction soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
Applied to my part, the loop goes over the functions but not over "List of welded parts". I added a Debug.Print swfeat. Name to see what comes out:
Favoris
Historique
Ensembles de sélections
Capteurs
Classeur de conception
Annotations
Marquages
Lumières, caméras et scène
Corps volumiques
Surface Bodies
Commentaires
Equations
S235
compared to the tree structure of my room (see attachment).
Article-list... right in the middle of the rest of the tree in the room. That's weird. Well, I should manage to get out of it by looking if I have the word "welded" in the swfeat. Name. The only problem with this method is that you have to be careful not to rename the welded bodies.
Here's the modified snippet of code if anyone ever needs it
Do While Not swfeat Is Nothing
Debug.Print swfeat.Name
If InStr(1, swfeat.Name, "soudée") <> 0 Then
'If swfeat.Name = "soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
Thank you d.roger
I don't know what your solidworks looks like but it almost has to do the design on its own by just clicking on a macro :-D
Be careful, from time to time you have to close the macro editor and re-open it (without forgetting to save your macro first), I noticed that after a while of use it has a little trouble freshening up, it can also come from there ...
In my macro I look for the "Welded construction" function which does not change even when renaming the welded bodies:
As for my SW, no it doesn't do the design by itself by clicking on a macro, although for some parts it's not very far from it :-)
you will have to think about validating the best answer if there is one that meets the request, it can help other users likely to have the same type of request ...
