Export Nomenclature vers Excel avec une Macro VBA

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 :

  1.  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.
  2.  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é

Oui, c'est coché ...

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