Bonjour,
Ce sujet fait suite à 2 autres posts sur le même sujet :
- - https://www.lynkoa.com/forum/solidworks/export-nomenclature-vers-excel-avec-une-macro-vba
- - https://www.lynkoa.com/forum/import-de-donn%C3%A9es-num%C3%A9ris%C3%A9es/export-nomenclature-vers-excel
Cette macro fonctionne bien et je vous en remercie. J'ai cependant deux petites remarques :
- elle ne prend pas en compte si des pièces sont définies ou pas en "Exclu de la nomenclature". Toutes les pièces ressortent dans le tableau Excel.
- pour les pièces mécanosoudées, la macro exporte chaque corps soudé comme une pièce à part entière alors que ces corps devraient être exclu de la nomenclature (enfin, dans mon cas).
Est-il possible de résoudre ces 2 petits problèmes par un bout de code supplémentaire ?
Si ce n'est pas possible de les masquer, peut-être est-il envisageable d'ajouter une colonne au fichier Excel avec une propriété "Exclu de la nomenclature" et comme valeur sur chaque ligne OUI ou NON.
Merci pour votre aide
Bonne journée
Bonjour,
Je ne sais pas de quelle macro tu es parti précisément et quelles modifications tu as faites mais c'est quand même bizarre que des pièces exclues de la nomenclature apparaissent dans cette dite nomenclature (sauf si celles-ci sont exclues de la nomenclature dans une configuration mais pas dans celle dont tu récupères la nomenclature).
Pour les pièces mécanosoudées, cela vient probablement du swBomType choisi pour la création de la nomenclature :
- "Indented" : tous les niveaux donc aussi les profilés des mécanosoudés.
- "TopLevelOnly" : seulement le premier niveau donc pas les profilés des mécanosoudés.
Sur ce lien il y a me semble-t-il toutes les informations utiles.
Cordialement,
1 « J'aime »
Bonjour,
Merci pour votre réponse. Oui, j'avais bien vu le sujet de discussion que vous mentionnez.
Si je change le swBomType en "TopLevelOnly", je n'ai effectivement que le 1er niveau, il me manque donc tous les sous-niveaux.
Si je met le swBomType en "Indented", ça descend jusqu'au corps des pièces mécanosoudées, ce qui est un étage trop bas.
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
Comment faire alors ?
Merci pour votre retour,
Cordialement
Bonjour,
Dans ce cas il est possible de mettre swBomType en "Indented" et récupérer le composant pour chaque ligne de la nomenclature à l'aide de la fonction Getcomponents2 afin de décider si il faut l'insérer ou non dans le fichier Excel, il te faudra peut-être te raccrocher à l'objet ModelDoc2 pour chaque composant pour l'analyser, cela peut se faire à l'aide de la fonction GetModelDoc2.
Cordialement,
Oula, on va toucher les limites de mes compétences en programmation.
J'ai l'impression que tout se joue à la ligne "Set swBOMAnnotation = swModelDocExt.InsertBomTable3..." là où la nomenclature est créée. Déjà ici, les corps de la pièce soudée apparaissent. En pièce jointe, la pièce en question.
Depuis SW, en modifiant manuellement les paramètres de la nomenclature, je n'arrive pas à cacher ces corps. Même décocher la case "Liste détaillée des pièces soudées" n'y fait rien.
Comment faire dans ce cas ?
Merci pour votre aide
test.zip
Bonjour,
Voici une solution possible, je suis reparti de la macro que j'avais déjà faite donc c'est à ré-adapter à ton cas mais le principe est : pour chaque ligne de la nomenclature je récupère le ModelDoc pour l'analyser et voir si c'est une construction soudée, si c'est le cas et que ce ModelDoc2 est le même qu'à la ligne précédente alors je n'en tient pas compte pour l'export vers Excel.
J'ai fait mes tests sur un de mes assemblages car je ne peux pas ouvrir le tient (version future).
Cordialement,
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
Bonjour monsieur,
Merci de prendre le temps de regarder mon problème. J'ai donc modifié ma macro avec vos préconisations.
Si je comprend bien, la macro passe en revue toutes les lignes de construction de la pièce et vérifie si elle trouve un texte "construction soudée".
Tout se passe dans cette boucle :
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
Appliqué à ma pièce, la boucle passe sur les fonctions mais pas sur "Liste des pièces soudées".
J'ai ajouté un Debug.Print swfeat.Name pour voir ce qu'il ressort :
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
comparé à l'arborescence de ma pièce (cf pièce jointe).
Encore merci pour votre aide
Bonne journée
arbre_piece.png
Bizarre, voici ce que j'ai dans un debug.print :
comparé à la pièce dans SW :
On n'y voit que je suis bien parti sur une construction soudée dans la construction de ma pièce ... dommage que je ne puisse pas ouvrir les pièces précédemment jointes ...
Cordialement,
Effectivement, c'est étrange.
Avez-vous la fonction de mise à jour automatique de cochée ?
Est-ce que cela pourrait venir de là ?
Merci d'avoir essayé
Mais ce qui est surprenant c'est que le debug.print ne sorte pas tout ce qu'il y a dans l'arbre de création, la pièce est bien chargée en mode résolu ?
Oui, la pièce est bien en résolu
et ça donne quoi avec l'assemblage et les pièces jointes ?
insert-bom-asm.zip
Je viens de retester, je viens de voir apparaitre
Boss.-Extru.3
Dégagement M81
Diamètre du perçage Ø12.0 (12)1
Article-liste-des-pièces-soudées1
Article-liste-des-pièces-soudées2
Article-liste-des-pièces-soudées3
Esquisse29
Esquisse2
Article-liste... en plein milieu du reste de l'arbre de la pièce. C'est étrange.
Bon, je devrais réussir à m'en sortir en cherchant si j'ai le mot "soudé" dans la swfeat.Name.
Le seul problème avec cette méthode c'est qu'il faut veiller à surtout ne pas renommer les corps soudés.
Voici le bout de code modifié si quelqu'un à besoin un jour
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
Merci d.roger
Je ne sais pas à quoi ressemble votre solidworks mais il doit presque faire la conception tout seul en cliquant juste sur une macro :-D
Attention, de temps en temps il faut fermer l'éditeur de macro et le ré-ouvrir (sans oublier de sauvegarder sa macro avant), j'ai remarqué qu'au bout d'un certain temps d'utilisation il a un peu de mal à se rafraichir, ça peut aussi venir de là ...
Dans ma macro je recherche la fonction "Construction soudée" qui elle ne change pas même en renommant les corps soudés :
Quant à mon SW, non il ne fait pas la conception tout seul en cliquant sur une macro, quoique pour certaines pièces s'en est pas très loin :-)
il faudra penser à valider la meilleure réponse si il y en a une qui répond à la demande, ça peut aider les autres utilisateurs susceptibles d'avoir le même type de demande ...
Cordialement,
Et juste pour le fun, la vidéo est de mauvaise qualité mais ça montre comment SW peut dessiner un pignon en développante de cercle quasiment tout seul :-)
usinage_pignon.mp4