| 12
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 
 |  
Sub Nomenclature()
 
'Declaration du nom des variables
Dim Monfichier As Document
Dim Monplan As DrawingDocument
Dim Mesfeuilles As DrawingSheets
Dim Mafeuille As DrawingSheet
Dim Mesvues As DrawingViews
Dim Mavue As DrawingView
Dim Mestableaux As DrawingTables
Dim Montableau As DrawingTable
Dim Fonddecalque As DrawingView
Dim Monfichierassemblage As ProductDocument
Dim Mesassemblages As Products
Dim Monassemblage As Product
Dim Monassemblagetemporaire As Product
Dim Manomenclature As Variant
 
'procedure de verification du fichier ouvert en cours
Set Monfichier = CATIA.ActiveDocument
'si oui
If Right(Monfichier.FullName, 10) <> "CATDrawing" Then
'si non
MsgBox "Veuillez d'abord ouvrir une mise en plan (*.CatDrawing)"
Exit Sub
End If
 
'Simplification des variables
Set Monplan = CATIA.ActiveDocument
Set Mesfeuilles = Monplan.Sheets
Set Mafeuille = Mesfeuilles.ActiveSheet
Set Mesvues = Mafeuille.Views
Set Mavue = Mesvues.Item(3)
Set Fonddecalque = Mesvues.Item("Background View")
Set Mestableaux = Fonddecalque.Tables
Set Monfichierassemblage = Mavue.GenerativeLinks.FirstLink.Parent
Set Mesassemblages = Monfichierassemblage.Product.Products
Set Manomenclature = CreateObject("Scripting.Dictionary")
 
 
'Declaration du nom des variables
Dim n As Integer
Dim ProductList() As Product
'lecture de la nomenclature du product
ReDim ProductList(Mesassemblages.Count) 'Total Number of Products
Dim Index As Integer
Index = 1
For n = 1 To Mesassemblages.Count
'Ajout de chaque assemblage a la nomenclature (si plusieurs assemblages)
Set Monassemblagetemporaire = Mesassemblages.Item(n)
If Manomenclature.exists(Monassemblagetemporaire.PartNumber) = True Then
Manomenclature.Item(Monassemblagetemporaire.PartNumber) = Manomenclature.Item(Monassemblagetemporaire.PartNumber) + 1
Else
Manomenclature.Add Monassemblagetemporaire.PartNumber, 1
'Creation de la nomenclature virtuelle
Set ProductList(Index) = Monassemblagetemporaire
Index = Index + 1
End If
Next n
 
 
'procedure de verification l'existance d'une nomenclature
For n = 1 To Mestableaux.Count
Set Montableau = Mestableaux.Item(n)
If Montableau.Name = "Nomenclature" Then
Dim RowCount As Integer
'comptage des lignes existantes
If Montableau.NumberOfRows > (Manomenclature.Count) Then
'mise a jour
For RowCount = (Manomenclature.Count + 1) To Montableau.NumberOfRows
'retrais des lignes en trop
Montableau.RemoveRow 2
Next RowCount
End If
If Montableau.NumberOfRows < (Manomenclature.Count + 1) Then
'ajout des nouvelles lignes
For RowCount = Montableau.NumberOfRows To (Manomenclature.Count)
Montableau.AddRow 2
Next RowCount
End If
GoTo POPULATEBOM
End If
Next n
 
 
'Choix de l'emplacement de la nomenclature
'(X,Y,(n+1)lignes,nombre de colonnes,hauteur de colonne,largeur de colonne)
Set Montableau = Mestableaux.Add(651, 66, Manomenclature.Count + 1, 7, 8, 10)
'Nomination de la nomenclature
Montableau.Name = "Nomenclature"
'Choix de l'emplacement du point d'accroche
Montableau.AnchorPoint = CatTableBottomLeft
 
 
'Insertion des donées de la nomenclature
POPULATEBOM:
'Nomination des colonnes
'entree du nom de la colonne 1 (position/repere) dans ligne 1 colonne 1
Call Montableau.SetCellString(1, 1, "Pos")
'entree du nom de la colonne 2  (nombre)dans ligne 1 colonne 2
Call Montableau.SetCellString(1, 2, "Nbr")
'entree du nom de la colonne 3 (reference) dans ligne 1 colonne 3
Call Montableau.SetCellString(1, 3, "Remarque")
'entree du nom de la colonne 4 (designation) dans ligne 1 colonne 4
Call Montableau.SetCellString(1, 4, "Designation")
'entree du nom de la colonne 8 (matière) dans ligne 1 colonne 5
Call Montableau.SetCellString(1, 5, "Matière")
'entree du nom de la colonne 6 (norme matière) dans ligne 1 colonne 6
Call Montableau.SetCellString(1, 6, "Norme matière")
'**************************************************************************************************************
'entree du nom de la colonne 7 (matière) dans ligne 1 colonne 6
Call Montableau.SetCellString(1, 7, "Matière")
'***********************************************************************************************************
 
'Dimensionnement des colonnes
'Dimensionnement de la colonne 1 (position/repere) a 9 mm
Call Montableau.SetColumnSize(1, 9)
'Dimensionnement de la colonne 2 (nombre) a 9 mm
Call Montableau.SetColumnSize(2, 9)
'Dimensionnement de la colonne 3 (Remarque) a 45 mm
Call Montableau.SetColumnSize(3, 45)
'Dimensionnement de la colonne 4 (Designation) a 45 mm
Call Montableau.SetColumnSize(4, 45)
'Dimensionnement de la colonne 5 (Matière) a 35 mm
Call Montableau.SetColumnSize(5, 35)
'Dimensionnement de la colonne 6 (Norme matière) a 35 mm
Call Montableau.SetColumnSize(6, 35)
 
'*************************************************************************************************************
'Dimensionnement de la colonne 7 (Matière) a 45 mm
Call Montableau.SetColumnSize(7, 45)
'****************************************************************************************************************
'justification des textes de la ligne de titre
For n = 1 To 7
Call Montableau.SetCellAlignment(1, n, CatTableMiddleCenter)
Next n
 
'Utilisation de la nomenclature virtuelle cree
Dim i As Integer
For n = 2 To Montableau.NumberOfRows
'Choix des colonnes
'numero de piece venant de la nomenclature creee dans l'assemblage
Call Montableau.SetCellString(n, 1, (n - 1))
'quantite de piece venant de la nomenclature creee dans l'assemblage
Call Montableau.SetCellString(n, 2, Manomenclature.Item(ProductList(n - 1).PartNumber))
'venant de la case "Définition" remplie dans les proprietes directes de la pièce
Call Montableau.SetCellString(n, 3, ProductList(n - 1).Definition)
'venant de la case "Référence" remplie dans les proprietes directes de la pièce
Call Montableau.SetCellString(n, 4, ProductList(n - 1).PartNumber) 'Part Number
'venant de la case "Nomenclature" remplie dans les proprietes directes de la pièce
Call Montableau.SetCellString(n, 5, ProductList(n - 1).Nomenclature)
'venant de la case "Description" remplie dans les proprietes directes de la pièce dans le produit
Call Montableau.SetCellString(n, 6, ProductList(n - 1).DescriptionInst)
'**********************************************************************************
 
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim ProductDrawn As Document
Set ProductDrawn = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.Item(1).GenerativeBehavior.Document
Dim Params As Parameters
Set Params = CATIA.ActiveDocument.Parameters
Dim Param_matiere As Parameter
Set Param_matiere = Params.GetItem("Matière")
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 
 
 
'venant du parametre "Matière" dans les parametres crées manuellement de la pièce
Call Montableau.SetCellString(n, 7, ProductList(n - 1).Item("Matière"))
'**********************************************************************************
 
'justification des textes de la nomenclature
For i = 1 To 2
'justification des textes des colonnes 1 et 2 (centres)
Call Montableau.SetCellAlignment(n, i, CatTableMiddleCenter)
'justification des textes des colonnes 3 et 4 (aligné a gauche)
Call Montableau.SetCellAlignment(n, i + 2, CatTableMiddleLeft)
'justification des textes des colonnes 5 et 6 (aligné a gauche)
Call Montableau.SetCellAlignment(n, i + 4, CatTableMiddleLeft)
Next i
Next n
 
End Sub | 
Partager