CATIA V5 | 3DEXPERIENCE
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
Le Deal du moment : -40%
Tefal Ingenio Emotion – Batterie de cuisine 10 ...
Voir le deal
59.99 €

Modification tableau drawing document

3 participants

Aller en bas

Modification tableau drawing document Empty Modification tableau drawing document

Message par Liocco08 Jeu 29 Fév 2024 - 9:48

Bonjour à tous,

Je suis actuellement en plein code dans la création d'une macro me permettant de générer une nomenclature produit pour un plan. L'idée est de ne plus avoir à se fader de récupérer les quantités, les noms, la description (etc...) des éléments d'un product et avoir a les insérer manuellement dans ma nomenclature sur mon plan d'ensemble.

J'ai adapté le tout à mon client, mais dernier détail que je n'arrive pas à régler c'est la mise en forme de mon tableau. Je souhaite modifier l'épaisseur des lignes de mon tableau (par défaut en 0.13mm et je souhaite les passer en 0.35mm), mais impossible de trouver la commande en VBA.

Voici ce que je souhaite faire par macro, image ci-dessous :

Image avant modification : https://i.servimg.com/u/f70/20/41/86/18/0110.jpg


Image après modification : https://i.servimg.com/u/f70/20/41/86/18/0210.jpg

Le code ci-dessous, désolé absolument pas commenté et vraiment pas digne d'un codeur (en même temps j'en suis pas un) :

Code:


Public Nomenclature(200, 9) As String
Public NomProduct(200, 9) As String
Public NomPart(200, 9) As String
Public NomPartStandard(200, 9) As String
Public NomPartDA(200, 9)  As String
Public EchelleC As String
Public SousEnsemble As String
Public SousEnsembleQuatre As String
Public DesignationSE As String
Public Format1 As String
Public derniere_ligne As Integer
Dim documents1 As Documents
Dim drawingDocument1 As DrawingDocument
Dim myView As DrawingViews
Dim nomPlanCATIA As String
Dim repertoire As String
Dim MyProductDocument As ProductDocument
Dim PresenceSym As String

Sub CATMain()

Call Debut_macro 'RefreshDisplayOff
   
Call LienProduct2 'Check le lien avec le product ?
         
Call Dessin_Nomenclature 'Dessine et rempli le tableau avec l'élément nomenclature (un tableau en VBA)
   
Call Fin_macro 'RefreshDisplayOn
   
End Sub
Sub LienProduct2()

' -------------------------
' Initialisation des variables
' -------------------------

derniere_ligne = 1
Set documents1 = CATIA.Documents
Set drawingDocument1 = CATIA.ActiveDocument
Set selection1 = drawingDocument1.Selection
Set myDrawing = CATIA.ActiveDocument                'plan actif
Set mysheets = myDrawing.Sheets
Set myActiveSheet = mysheets.ActiveSheet            'feuille active / calque actif
Set myView = myActiveSheet.Views
Format1 = Left(myActiveSheet.PaperName, 2)

For k = 1 To myView.Count
    If myView.Item(k).Name = "Vue de face" Or myView.Item(k).Name = "Front view" Then  'RAPPEL : 1->calque vu, 2->fond calque, après ça s'incrémente au file de la création des vues.
        Set myFirstView = myView.Item(k)
        KEnreg = k
        k = myView.Count
    End If
Next k

' -------------------------
' Récupère l'echelle de la vue de face
' -------------------------
   
Echelle = 1 / (myView.Item(KEnreg).Scale) 'Valeur de l'echelle
For m = 1 To 10
    If Echelle * m = Round(Echelle * m, 0) Then
        EchelleA = m
        EchelleB = Echelle * m
        m = 10
    End If
Next m

EchelleC = EchelleA & ":" & EchelleB ' Permet de récupérer la valeur de l'echelle
   
   
' -------------------------
' Récupère les liens avec la vue
' -------------------------

myFirstView.Activate                                'active la premiere vu créé.    RAPPEL : 1->calque vu, 2->fond calque, après ça s'incrémente au file de la création des vues.
Set Doc_3D = myFirstView.GenerativeBehavior.Document
Dim lien_Doc_3D As String
lien_Doc_3D = myFirstView.GenerativeBehavior.Document.Parent.FullName  'Dossier d'enregistrement du product

Dim MyProductDocument As Product
Set MyProductDocument = Doc_3D
SousEnsemble = MyProductDocument.Name
SousEnsembleQuatre = Right(SousEnsemble, 4) 'Permet d'ienditifer par le repère mais ne fonctionnera pas pour Dassault
DesignationSE = MyProductDocument.DescriptionRef
   
   
   
For i = 1 To MyProductDocument.Products.Count
 '------- Elements dans un composant----------- J'IGNORE COMPLETEMENT LES COMPOSANTS
    'If MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name = MyProductDocument.ReferenceProduct.Parent.Name Then
        'Set Le_composant = MyProductDocument.Products.Item(i)
        'For j = 1 To Le_composant.Products.Count
            'Dim PartAA As Object
            'Set PartAA = Le_composant.Products.Item(j)
            'nom_part = PartAA.PartNumber
   
    'MsgBox Right(MyProductDocument.Products.Item(i).PartNumber, 7)
   
        '------- Si c'est un PRODUCT -----------'

    If Right(MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name, 10) = "CATProduct" And MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name <> MyProductDocument.ReferenceProduct.Parent.Name Then
   
        Set le_product = MyProductDocument.Products.Item(i)
        Nom_produit = le_product.PartNumber
        Prod_existe = 0
        For k = 0 To derniere_ligne                    'parcours le tableau
            If NomProduct(k, 7) = le_product.PartNumber Then      'vérifie si le part existe
                Prod_existe = 1
                NomProduct(k, 3) = NomProduct(k, 3) + 1 'incrémente la nomenclature
            End If
        Next k
        If Prod_existe = 0 Then                        'si le part n'existe pas encore dans le tableau
           
            NomProduct(derniere_ligne, 2) = Right(le_product.PartNumber, 6)
            NomProduct(derniere_ligne, 3) = 1
            NomProduct(derniere_ligne, 4) = le_product.DescriptionRef  'la la derniere ligne prend la valeur du part
            NomProduct(derniere_ligne, 7) = Nom_produit
            NomProduct(derniere_ligne, 9) = Right(le_product.PartNumber, 6)
            derniere_ligne = derniere_ligne + 1        'la derniere ligne decent d'une case
       
        End If
       
    End If
           
    '------- Si c'est une PART -----------'
    If Right(MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name, 7) = "CATPart" And MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Path = "M:\AFFAIRES\22776-DASSAULT-FAL Falcon 10X\7- Etudes\1_3D" Then
        Set le_part = MyProductDocument.Products.Item(i)
        nom_part = le_part.PartNumber
        Part_existe = 0
       
            '------- Vérification si elle existe -----------
        For k = 0 To derniere_ligne                    'parcours le tableau
            If NomPart(k, 2) = Right(le_part.PartNumber, 6) Then
                Part_existe = 1
                NomPart(k, 3) = NomPart(k, 3) + 1 'incrémente la nomenclature pour la quantité
            End If
        Next k
       
        If Part_existe = 0 Then                        'si le part n'existe pas encore dans le tableau
            If Left(Right(le_part.PartNumber, 6), 1) = "0" Then
                NomPart(derniere_ligne, 2) = Right(le_part.PartNumber, 6)
                NomPart(derniere_ligne, 9) = Right(le_part.PartNumber, 6)
            End If
   
            NomPart(derniere_ligne, 3) = 1
            NomPart(derniere_ligne, 4) = le_part.DescriptionRef  'la derniere ligne prend la valeur du part 1
            derniere_ligne = derniere_ligne + 1        'la derniere ligne decent d'une case
           
        End If
 
    End If
   
   
    '------- Si c'est une part à valider -----------'
       
    If Right(MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name, 7) = "CATPart" And MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Path = "M:\AFFAIRES\22776-DASSAULT-FAL Falcon 10X\7- Etudes\1_3D\LIBRAIRIE BESOIN A VALIDER" Then
       
        Set le_part = MyProductDocument.Products.Item(i)
        nom_part = le_part.PartNumber
        Part_existe = 0
        For k = 0 To derniere_ligne                    'parcours le tableau
            If NomPartStandard(k, 9) = le_part.Nomenclature Then      'vérifie si le part existe
                Part_existe = 1
                NomPartStandard(k, 3) = NomPartStandard(k, 3) + 1 'incrémente la nomenclature pour la quantité
            End If
        Next k
        If Part_existe = 0 Then                        'si le part n'existe pas encore dans le tableau
               
            NomPartStandard(derniere_ligne, 3) = 1
            NomPartStandard(derniere_ligne, 4) = le_part.DescriptionRef  'la derniere ligne prend la valeur du part 1
            NomPartStandard(derniere_ligne, Cool = Mid(le_part.Definition, 1, Len(le_part.Definition) - Len(le_part.Nomenclature) - 1)
            NomPartStandard(derniere_ligne, 9) = le_part.Nomenclature
           
            derniere_ligne = derniere_ligne + 1        'la derniere ligne decent d'une case
     
        End If
       
    End If
 
    '------- Si c'est une part de la biblio à Dassault -----------'

        'MsgBox "La part " & MyProductDocument.Products.Item(83).PartNumber & " est enregistrée ici : " & MyProductDocument.Products.Item(83).ReferenceProduct.Parent.Path
    If MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Path = "M:\AFFAIRES\22776-DASSAULT-FAL Falcon 10X\7- Etudes\8 - LSTD - Librairie Dassault" Then 'And Left(MyProductDocument.Products.Item(i).PartNumber, 3) = "ISO" Then A rajouter quand on voudra trier
       
        Set le_part = MyProductDocument.Products.Item(i)
        nom_part = le_part.PartNumber
        Part_existe = 0
       
        For k = 0 To derniere_ligne                    'parcours le tableau
            If NomPartDA(k, 7) = MyProductDocument.Products.Item(i).PartNumber Then      'vérifie si le part existe
                Part_existe = 1
                NomPartDA(k, 3) = NomPartDA(k, 3) + 1 'incrémente la nomenclature pour la quantité
            End If
        Next k
        If Part_existe = 0 Then                        'si le part n'existe pas encore dans le tableau
       
            NomPartDA(derniere_ligne, 3) = 1
            NomPartDA(derniere_ligne, 4) = le_part.DescriptionRef  'la derniere ligne prend la valeur du part 1
            NomPartDA(derniere_ligne, 7) = MyProductDocument.Products.Item(i).PartNumber

            If Left(MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name, 9) = "ISO_10511" Or Left(MyProductDocument.Products.Item(i).ReferenceProduct.Parent.Name, 9) = "ISO_10642" Then
           
                NomPartDA(derniere_ligne, Cool = Left(MyProductDocument.Products.Item(i).PartNumber, 9)

            Else
           
                NomPartDA(derniere_ligne, Cool = Left(MyProductDocument.Products.Item(i).PartNumber, Cool
           
            End If

            derniere_ligne = derniere_ligne + 1        'la derniere ligne decent d'une case

        End If
       

    End If
   



Next i


For j = 1 To derniere_ligne
 
    Nomenclature(j, 1) = CStr(NomProduct(j, 1) + NomPart(j, 1) + NomPartStandard(j, 1) + NomPartDA(j, 1))
    Nomenclature(j, 2) = CStr(NomProduct(j, 2) + NomPart(j, 2) + NomPartStandard(j, 2) + NomPartDA(j, 2))
    Nomenclature(j, 3) = CStr(NomProduct(j, 3) + NomPart(j, 3) + NomPartStandard(j, 3) + NomPartDA(j, 3))
    Nomenclature(j, 4) = CStr(NomProduct(j, 4) + NomPart(j, 4) + NomPartStandard(j, 4) + NomPartDA(j, 4))
    Nomenclature(j, Cool = CStr(NomProduct(j, Cool + NomPart(j, Cool + NomPartStandard(j, Cool + NomPartDA(j, Cool)
    Nomenclature(j, 9) = CStr(NomProduct(j, 9) + NomPart(j, 9) + NomPartStandard(j, 9) + NomPartDA(j, 9))
 
Next j



For k = 1 To derniere_ligne

   
    If Left(Nomenclature(k, 9), 1) = "0" Then
   
        Nomenclature(k, 2) = Left(Nomenclature(k, 2), 2) & " " & Mid(Nomenclature(k, 2), 3, 2) & " " & Right(Nomenclature(k, 2), 2)
        Nomenclature(k, 9) = Left(Nomenclature(k, 9), 2) & " " & Mid(Nomenclature(k, 9), 3, 2) & " " & Right(Nomenclature(k, 9), 2)
    End If
   
   
    If k < 10 Then
        Nomenclature(k, 1) = "0" & CStr(k)
    Else
        Nomenclature(k, 1) = CStr(k)
    End If
   
    For m = 1 To 9

   
        If Nomenclature(k, m) = "" Then
       
            Nomenclature(k, m) = "+"
       
        End If
       
    Next m
   
        If Left(Nomenclature(k, 9), 1) = "" Then
       
            Nomenclature(k, 9) = "+"
       
        End If
       
Next k

   
    '-----------------------------------------------
End Sub


Sub Dessin_Nomenclature()
   
' -------------------------
' Déclaration des variables
' -------------------------

Dim MyTable As DrawingTable

' -------------------------
' Initialisation des variables
' -------------------------

Set mybackview = myView.Item(2)
mybackview.Activate
Set myTables = mybackview.Tables
nbTables = myTables.Count
 
MyTable.ComputeMode = CatTableComputeOFF
' -------------------------
' Supprime le tableau existant
' -------------------------

For i = 1 To nbTables
    nbLignes = myTables.Item(i).NumberOfRows
    If myTables.Item(i).Name = "nomenclatureSe" Then
        Set sel = CATIA.ActiveDocument.Selection
        sel.Clear
        sel.Add myTables.Item(i)
        sel.Delete
    End If
Next i

' -------------------------
' Vérifie le format de la feuille et ajuste la position du tableau
' -------------------------

If Format1 = "A0" Then
    'Set MyTable = mybackview.Tables.Add(1179, 146, 1, 7, 200, 10)
    Set MyTable = mybackview.Tables.Add(1179, 122, 1, 9, 200, 10) 'Valeur pour Dassault
End If
If Format1 = "A1" Then
    Set MyTable = mybackview.Tables.Add(831, 122, 1, 9, 200, 10)
End If
If Format1 = "A2" Then
    Set MyTable = mybackview.Tables.Add(584, 122, 1, 9, 200, 10)
End If
If Format1 = "A3" Then
    Set MyTable = mybackview.Tables.Add(410, 122, 1, 9, 200, 10)
End If
   
   
   

   
   
MyTable.Name = "nomenclatureSe"
MyTable.AnchorPoint = CatTableBottomRight

MyTable.SetColumnSize 1, 12
MyTable.SetColumnSize 2, 25
MyTable.SetColumnSize 3, 12
MyTable.SetColumnSize 4, 95
MyTable.SetColumnSize 5, 30
MyTable.SetColumnSize 6, 16
MyTable.SetColumnSize 7, 30
MyTable.SetColumnSize 8, 30
MyTable.SetColumnSize 9, 35

MyTable.SetRowSize 1, 6

MyTable.SetCellString 1, 1, "Rep." 'ligne, colonne, valeur
MyTable.SetCellString 1, 2, "Planche"
MyTable.SetCellString 1, 3, "Qté"
MyTable.SetCellString 1, 4, "Désignation"
MyTable.SetCellString 1, 5, "Matière"
MyTable.SetCellString 1, 6, "Etat"
MyTable.SetCellString 1, 7, "Dim.Brutes"
MyTable.SetCellString 1, 8, "Traitement"
MyTable.SetCellString 1, 9, "Réf.Article"

Dim TempText As DrawingText


'text_5.SetFontName 1, Len(text_5.Text), "Arial (TrueType)"
'text_5.SetParameterOnSubString catBold, 0, Len(text_5.Text), 1
'text_5.SetParameterOnSubString catItalic, 1, Len(text_5.Text), 0

For C = 1 To 9

    Set TempText = MyTable.GetCellObject(1, C)
    MyTable.GetCellObject(1, C).SetFontSize 0, 0, 2.5
    MyTable.GetCellObject(1, C).SetParameterOnSubString catItalic, 0, Len(TempText.Text), 1
   
Next C


' -------------------------
' Remplit le tableau avec les éléments contenus dans le tableau (VBA) nomenclature
' -------------------------
   


For i = 1 To derniere_ligne - 1
    MyTable.AddRow 1
    If Nomenclature(i, 1) <> "" Then
        MyTable.SetCellString 1, 1, Nomenclature(i, 1)
    End If
    If Nomenclature(i, 2) <> "" Then
        MyTable.SetCellString 1, 2, Nomenclature(i, 2)
    End If
    If Nomenclature(i, 3) <> "" Then
        MyTable.SetCellString 1, 3, Nomenclature(i, 3)
    End If
    If Nomenclature(i, 4) <> "" Then
        MyTable.SetCellString 1, 4, Nomenclature(i, 4)
    End If
    If Nomenclature(i, 5) <> "" Then
        MyTable.SetCellString 1, 5, Nomenclature(i, 5)
    End If
    If Nomenclature(i, 6) <> "" Then
        MyTable.SetCellString 1, 6, Nomenclature(i, 6)
    End If
    If Nomenclature(i, 7) <> "" Then
        MyTable.SetCellString 1, 7, Nomenclature(i, 7)
    End If
    If Nomenclature(i, Cool <> "" Then
        MyTable.SetCellString 1, 8, Nomenclature(i, Cool
    End If
    If Nomenclature(i, 9) <> "" Then
        MyTable.SetCellString 1, 9, Nomenclature(i, 9)
    End If
   
    For j = 1 To 9
        MyTable.GetCellObject(1, j).SetFontSize 0, 0, 2.5
        MyTable.SetRowSize i, 6
       
    Next j
   
Next i
   
For i = 1 To derniere_ligne
    For j = 1 To 9
        MyTable.SetCellAlignment i, j, CatTableMiddleCenter
    Next j
Next i

Dim p As Integer

For i = 1 To MyTable.NumberOfColumns

    For j = 1 To MyTable.NumberOfRows
   
        If MyTable.GetCellString(j, 2) <> "+" Then
       
            MyTable.AddRow j
            p = j
            MyTable.SetCellString j, 1, "+"
            MyTable.SetCellString j, 2, "+"
            MyTable.SetCellString j, 3, "+"
            MyTable.SetCellString j, 4, "+"
            MyTable.SetCellString j, 5, "+"
            MyTable.SetCellString j, 6, "+"
            MyTable.SetCellString j, 7, "+"
            MyTable.SetCellString j, 8, "+"
            MyTable.SetCellString j, 9, "+"
           
           

            GoTo fin
        End If
   
    Next j
   
Next i

fin:

Dim NumberLine As Integer
Dim NewStartNumber As Integer
'NumberLine = InputBox("Veuillez saisir le numéro de ligne  après les parts fabriqués : ", "Renumérotation")
NumberLine = p

'MsgBox (MyTable.NumberOfRows - p - 1)
NewStartNumber = InputBox("Veuillez saisir le renumérotation après les parts fabriqués : |||  " & MyTable.GetCellString(p + 1, 1) & " ||| Augmenter d'une dizaine selon SOS Dassault", "Renumérotation")


For i = NumberLine - 1 To 1 Step -1

    MyTable.SetCellString i, 1, CStr(NewStartNumber)
    NewStartNumber = NewStartNumber + 1

Next i



Dim LenghtText As DrawingText


For i = 1 To MyTable.NumberOfRows - 1

    For j = 1 To MyTable.NumberOfColumns
   
        Set TempText = MyTable.GetCellObject(i, 1)
        Set LenghtText = MyTable.GetCellObject(i, j)
        MyTable.GetCellObject(i, 1).SetParameterOnSubString catBold, 0, Len(TempText.Text) + 1, 1
        MyTable.GetCellObject(i, j).SetParameterOnSubString catItalic, 0, Len(LenghtText.Text) + 1, 1
        TempText.SetFontSize 1, Len(TempText.Text), 3.5
       
    Next j
   
Next i


MyTable.ComputeMode = CatTableComputeON



End Sub
 
Sub Debut_macro()

CATIA.DisplayFileAlerts = False            'déactive les alertes

End Sub

Sub Fin_macro()

CATIA.DisplayFileAlerts = True              'réactive les alertes
MsgBox ("La nomenclature est disponible et éditable dans le fond de calque de votre plan. Veuillez procéder aux vérifications des éléments critiques. "), vbInformation, ("Fin de l'éxécution de la macro 2024©")

End Sub









Liocco08
actif
actif

Messages : 39
Date d'inscription : 07/04/2022
Localisation : Toulouse

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par lumpazepfel Lun 4 Mar 2024 - 21:05

Bonjour,

D'après l'aide, l'épaisseur de trait ne semble pas accessible par VBA.

Une autre solution peut être de créer un CATDrawing template dans lequel tu fais un tableau vide dans la bonne configuration et avec ta macro tu ouvre le CATDrawing et tu recopies la tableau puis tu le complètes.

Modification tableau drawing document Border10
lumpazepfel
lumpazepfel
Fédérateur
Fédérateur

Messages : 316
Date d'inscription : 02/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par Liocco08 Mer 6 Mar 2024 - 14:05

Merci pour ta réponse ! Effectivement pour que ça fonctionne ça semble faisable, mais je pense que dans un 1er temps je vais simplement indiquer aux utilisateurs de le faire à l main (n'ayant pas le temps de bosser sur ce sujet).

Peux-tu me dire comment tu fais pour trouver cette aide dans la photo ? Je passe systématiquement par l'aide CatiaAutomation que je trouve moins pratique

En revanche, autre petite question :

Lorsque je nomenclature un ensemble, il arrive régulièrement que je soit dans l'obligation de rajouter des pièces au début de la nomenclature ce qui décale tous les numéros...

Facile de renommer dans le tableau avec une macro, par contre plus difficile de modifier les bulles déjà créée... Tu sais comment intervenir et modifier la valeur de ces bulles ?

J'ai ce code permettant de les sélectionner (donc les compter), mais impossible d'accéder à la valeur ou le nom...

Code:


Sub CATMain()

Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection

selection1.Search "CATDrwSearch.DrwBalloon,all"


End Sub


Liocco08
actif
actif

Messages : 39
Date d'inscription : 07/04/2022
Localisation : Toulouse

Revenir en haut Aller en bas

Modification tableau drawing document Empty [UPDATE]

Message par Liocco08 Mer 6 Mar 2024 - 16:22

J'ai finalement trouvé, il semblerait que ces éléments en soient qu'une manière déguiser d'utiliser un text entouré d'une bulle. J'avoue avoir du mal à comprendre, mais voici le code. J'optimiserai quand j'aurais un peu temps en réalisant une interface graphique avec UserForm et en lien avec le tableau de nomenclature.

Code:


Sub CATMain()

'selection1.Search "CATDrwSearch.DrwBalloon,all"

Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument

Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets

Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Item("Calque.1")

Dim drawingViews1 As DrawingViews
Set drawingViews1 = drawingSheet1.Views

Dim drawingView1 As DrawingView
'Set drawingView1 = drawingViews1.Item("Vue de face")

Dim NombreBulle As Integer
Dim ValeurDécalage As Integer
Dim ValeurPasDépasser As Integer
Dim ValeurDébut As Integer

ValeurDébut = InputBox("Veuillez saisir le commencement de la renumérotation")
ValeurDécalage = InputBox("Veuillez saisir le nombre de décalage")
ValeurPasDépasser = InputBox("Veuillez saisir les numérosà partir duquel il ne faut pas renuméroter")

'drawingView1.Activate


For i = 4 To drawingViews1.Count

    If Left(drawingViews1.Item(i).Name, 3) <> "NOT" Then ' Si ce n'est pas un NOTA
       
        Set drawingView1 = drawingViews1.Item(i)
        drawingView1.Activate
        NombreBulle = drawingViews1.Item(i).Texts.Count
       
       
        For j = 1 To NombreBulle
       
            If Left(drawingViews1.Item(i).Texts.Item(j).Name, 3) = "Num" Then ' Si l'élément text est une bulle
                     
                If CInt(drawingViews1.Item(i).Texts.Item(j).Text) <= ValeurPasDépasser And CInt(drawingViews1.Item(i).Texts.Item(j).Text) >= ValeurDébut Then
                         
                    If Left(drawingViews1.Item(i).Texts.Item(j).Text, 1) = "0" Then ' Si la 1ère valeur est un 0
                       
                        If CInt(drawingViews1.Item(i).Texts.Item(j).Text + ValeurDécalage) >= 10 Then 'Si la somme est <= à 10 on écrit le résultat
                           
                            drawingViews1.Item(i).Texts.Item(j).Text = CInt(drawingViews1.Item(i).Texts.Item(j).Text) + ValeurDécalage
                           
                        Else ' Sinon, cest entre 1 et 9 donc on garde le 0
                       
                            drawingViews1.Item(i).Texts.Item(j).Text = CStr("0" & CInt(drawingViews1.Item(i).Texts.Item(j).Text) + ValeurDécalage)
                       
                        End If
                       
                   
                    Else ' Si c'est >10 alors on ajoute
                   
                        drawingViews1.Item(i).Texts.Item(j).Text = CInt(drawingViews1.Item(i).Texts.Item(j).Text) + ValeurDécalage
                   
                    End If
               
                End If
           
            End If
           
        Next j
       
       
    End If


Next i


'MsgBox drawingDocument1.Sheets.Item(1).Views.ActiveView.Texts.Item(13).Name
'drawingDocument1.Sheets.Item(1).Views.ActiveView.Texts.Item(13).Text = "CECI EST UN TEST"
'MyTable.GetCellObject(1, C).SetParameterOnSubString catItalic, 0, Len(TempText.Text), 1 'type, ou ça commence, la longueur, et la valeur ?
'MsgBox drawingDocument1.Sheets.Item(1).Views.ActiveView.Texts.Item(13).Name


End Sub




Liocco08
actif
actif

Messages : 39
Date d'inscription : 07/04/2022
Localisation : Toulouse

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par lumpazepfel Jeu 7 Mar 2024 - 14:05

Salut Julien,

Pour l'aide, il s'agit de l'explorateur d'objets de l'éditeur VBA:
Modification tableau drawing document Explor10

La fenêtre des variables locales est aussi intéressante:
Modification tableau drawing document Balloo10

Pour ton code, le bullage fait effectivement parti de la collection des DrawingTexts, mais je te conseil de garder ta selection qui fait déjà un premier tri et ne sélectionne que les bulles à condition bien sûr qu'elles aient été créées avec la fonction numéro de pièce et pas du texte avec une bulle (comme certains font  Modification tableau drawing document 1f625 )

Tu peux récupérer le nom et la valeur et d'autres infos (voir la fenêtre des variables locales) comme ceci:
Code:

Sub catmain()

Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
Dim myBalloon As DrawingText
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection
selection1.Search "CATDrwSearch.DrwBalloon,all"

nbBalloons = selection1.Count
For i = 1 To nbBalloons
    Set myBalloon = selection1.Item(i).Value
    MsgBox myBalloon.Text & "-" & myBalloon.Name
    
Next

End Sub

Tu peux aussi rechercher une bulle :

Code:

Dim selection1 As Selection
Dim myBalloonTxt As String
Set myBalloonTxt = "N° à chercher"
    mySearch = "CATDrwSearch.DrwBalloon.BalloonPartName=" & myBalloonTxt & ",all"
    selection1.Search mySearch
lumpazepfel
lumpazepfel
Fédérateur
Fédérateur

Messages : 316
Date d'inscription : 02/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par Xavier KLEIN Jeu 7 Mar 2024 - 18:27

Bonjour
pour faire une nomenclature ,tu as utilisé solution , je parcours mon arbre et j'analyse chaque noeud
il y a une api qui génère directement la nomenclature en Excel (comme la fonctio BOM de catia en mode UI
=> si tu souhaite avoir resultat dans un tableau, il te "suffit" de lire le fichier excel et insérer les doonnées dans tableau
--
je confirme que si tableau standrad ne convient pas , le plus simple est de copier coller tableau depuis un fichier template

Xavier KLEIN
timide
timide

Messages : 4
Date d'inscription : 10/04/2018
Localisation : Haute Savoie

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par Liocco08 Lun 11 Mar 2024 - 11:11

Lumpazepfel

Merci pour ces précisions Lumpa, tout va beaucoup m'épauler pour les prochaines macro et/ou optimisation de code.

Je tendance à ne pas aimer manipuler cette fonction selection en VBA, même si elle s'avère extrêmement pratique.


Xavier,

Effectivement on a aussi cette solution mais l'avantage de la macro est qu'on a pas à générer des fichiers Excel en //. Il suffit de cliquer sur l'icône de la barre d'outil et hop ça génère tout (alors oui le code est + lourd et légèrement + long, mais plus simple à diffuser dans l'entreprise).

De plus, je souhaite intégrer une interface graphique type ListBox ou autre me permettant de gérer les éléments spécifiques et pouvoir ajuster l'ordre de la nomenclature manuellement (mais tu me diras c'est potentiellement faisable aussi avec ta solution).

Merci pour ces précisions !

Liocco08
actif
actif

Messages : 39
Date d'inscription : 07/04/2022
Localisation : Toulouse

Revenir en haut Aller en bas

Modification tableau drawing document Empty Re: Modification tableau drawing document

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum