Bonjour à tous,
le but est de créer automatiquement via une macro VBA une nomemclature dans un assemblage, exporter cette dernière vers un fichier Excel dont le nom sera le nom fichier pièce + une proprété personalisée. Enfin la macro doit supprimerla nomenclature créée.
Nous ne disposons pas des outils My Cad - Solidworks Prenium
Bonjour,
Sa ressemble beaucoup à une annonce de travail lol
Sinon as tu commencé a regardé du coté de l'enregistreur de macro ?
Cordialement
Bonjour,
tu as déjà un bout de code à nous montré ?
Dimitri.
Bonjour,
Regarde la macro jointe, normalement tout y est (un peu en vrac et sans controle de sécurité). Change au moins les lignes :
TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
Configuration = "Défaut"
If vPropNames(K) = "DESSINATEUR" Then
Pour mettre le chemin vers ton modèle de nomenclature, le nom de ta configuration par défaut dans tes asm et le nom de ta propriété personalisée que tu veux dans le nom du fichier.
Cordialement,
Merci pour ta réponse d.roger, la macro fonctionne, seul petit problème, quand je mets la propriété personalisé là ou te me l'as indiqué la valeur de la propriété n'est pas renvoyée dans le nom fichier. J'ai l'impression que la ligne créant le nom du fichier dans la macro, il n'ya aps de rappelle de la propiété, j'ai essayé de la rajouté mais les test ne sont pas concluant de ce côté.
Bonjour,
Il faut que tu remplaces les 2 lignes :
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager
qui récupèrent la valeur demandée dans la configuration active par :
Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
qui récupérera la valeur dans l'onglet "Personnaliser"
Cordialement,
Parfait en réalisant cette modification la macro fontionne comme je le voulais. Juste pour amélioration est-il possible d'enregistrer le tableur dans le meme dossier que l'assemblage.
Bonjour,
Oui c'est possible, tu remplace la ligne :
chemin = Environ("USERPROFILE") & "\Desktop\" & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & NomProperty & ".xlsx"
par :
chemin = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty & ".xlsx"
Cordialement,
Bonjour,
Si tu veux aussi donner un peu de mise en page à ton fichier Excel, tu peux ajouter des lignes comme par exemple :
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
En lieu et place de :
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
la ligne :
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
est particulièrement interressante si tu as des valeurs numérique commençant par 0 car cela met la cellule Excel au format texte et évite donc de perdre le 0 du début.
Cordialement,
Bonjour,
Avant tout, merci pour ce partage, c'est vraiment génial de trouver ici des infos de cette qualité !
Je suis en train d'essayer de paramétrer la macro d'export de nomenclatures ; malheureusement je ne parviens pas à la faire fonctionner.
J'ai message "Erreur d'éxecution 91 Variable objet ou variable de bloc with non définie" sur les lignes suivantes :
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature
Avez-vous une idée de ce qui pourrait poser problème ?
Merci d'avance !
Bonjour,
le hasard justement c'est que je travail sur de la nomenclature automatique est cette macro arrive juste à point. J'ai juste un souci c'est qu'elle récupère les informations sur des pièces de premier niveau et non sur des pièces dans un assemblages ou sous assemblage de sous assemblage d'assemblage etc..
il y at il une solution?
merci
que la force soit avec vous.
Bonjour OBI WAN,
Oui il y a une solution, tu remplace la ligne "BomType = swBomType_TopLevelOnly" par "BomType = swBomType_Indented", cela devrait te mettre la nomenclature en multi-niveau.
Cordialement,
Bonjour s.descamps,
As-tu bien remplacé le chemin d'accès à ton modèle de nomenclature dans la ligne "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"" ?
Ou encore le nom de la configuration par une configuration valide dans la ligne "Configuration = "Défaut"" ?
Cordialement,
Bonjour,
Je n’arrive pas a télécharger la macro mentionner par @d.roger 
Es ce que quelqu’un sait pourquoi ?
Merci d’avance !
Bonjour,
Je pense que c’est lié au fait que le fichier est sur l’ancien url du site. Pas sécurisé donc du coup le navigateur bloque (en tout cas c’est ce qu’il se passe chez moi)
Bonjour;
Je n’ai pas de problèmes pour la télécharger (Firefox ?) la voici (de nouveau):
insert-bom-asm.swp (77,5 Ko)
et si vraiment cela ne marche pas, voici la version « Tapuscrit »:
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
Cordialement.
Bonjour,
Sur ce lien ça fonctionne. Sur celui d’origine sur Edge ça génère une erreur liée à la sécurité du téléchargement.
Ben ça alors…y’a des gens qui utilisent « Edge » !!!
Pas le choix 