Section programmation CatScript, VBA, VB.NET...

Voilà mon code actuel

Le code à besoin de :
1 combobox : lst_imprimantes
1 label : lab_repertoire
2 bouton : btn_repertoire, btn_imprime
1 listbox : lst_fichiers

Code lié au module :

Code:

Sub CATMain()
    Load Page
    Page.Show
End Sub



code lié à la "Form" :

Code:


Dim repertoire
Dim imprimantes As Printers
Dim imprimante As Printer
Dim selection_impression As String
Dim n_selection As Integer

Private Sub btn_imprime_Click()
'initialisation des parametres
    Dim Documents As Documents
    Dim Document As Document
    Dim DrwDocument As DrawingDocument
    Dim DrwSheets As DrawingSheets
    Dim DrwSheet As DrawingSheet
    Dim Conf_impression As DrawingPageSetup
'création d'un fentre sinon les moethode liées à l'impression ne sont pas disponibles
    Set Document = CATIA.Documents.Add("Part")
    Set Documents = CATIA.Documents
    n_selection = lst_fichiers.ListCount
'Traitement de chaque éléments séléctioné dans la liste
    For n = 0 To n_selection - 1
        If lst_fichiers.Selected(n) Then
            selection_impression = repertoire + "" + lst_fichiers.List(n) 'chargement d'un drawing
            Set DrwDocument = Documents.Read(selection_impression)
            Set DrwSheets = DrwDocument.Sheets
            Set DrwSheet = DrwSheets.Item(1)
            Set Conf_impression = DrwSheet.PageSetup 'paramètrage du format d'impression
            Conf_impression.Orientation = imprimante.Orientation
            Conf_impression.PaperSize = imprimante.PaperSize
            Conf_impression.PaperHeight = imprimante.PaperHeight
            Conf_impression.PaperWidth = imprimante.PaperWidth
            DrwSheet.PrintOut 'imprsionn
            DrwDocument.Close 'fermeture du drawing
        End If
    Next
Document.Close 'fermeture de la fenetre
End Sub

Private Sub btn_repertoire_Click()
    repertoire = choix_rep("choix du répètroire")
    lab_repertoire = repertoire + ""
    scan_repertoire (repertoire)
    Call trie(lst_fichiers)
End Sub

Function choix_rep(titre)
    Set objShell = CreateObject("shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, titre, 0)
    If (Not objFolder Is Nothing) Then
        choix_rep = objFolder.Items.Item.Path
    End If
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Sub scan_repertoire(ByVal rep)
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    lst_fichiers.Clear
    On Error GoTo erreur
    Set contenu_rep = FSO.GetFolder(rep)
        For Each fichier In contenu_rep.Files
            If (InStr(1, fichier.Name, ".catdrawing", 1) > 0) Then
                lst_fichiers.AddItem fichier.Name
            End If
        Next
    lst_fichiers.Enabled = True

Exit Sub
erreur:
        MsgBox ("erreur de séléction du répertoire")
End Sub

Private Sub lst_fichiers_Change()
    btn_imprime.Enabled = False
    For n = 0 To lst_fichiers.ListCount - 1
        If lst_fichiers.Selected(n) = True Then btn_imprime.Enabled = True
    Next n
End Sub

Private Sub lst_imprimantes_Change()
    Set imprimantes = CATIA.Printers
    CATIA.ActivePrinter = imprimantes.Item(lst_imprimantes.Text)
    Set imprimante = CATIA.ActivePrinter
   
End Sub

Private Sub UserForm_Activate()
    Set imprimantes = CATIA.Printers
    For Each imprimante In imprimantes
        lst_imprimantes.AddItem imprimante.DeviceName
    Next
    Set imprimante = CATIA.ActivePrinter
    lst_imprimantes.Text = imprimante.DeviceName
End Sub

Private Sub trie(ByRef LB As ListBox)
    Dim First, Last, i, j As Integer
    Dim Temp As String
    Dim TempArray As Variant
   
    ReDim TempArray(LB.ListCount)
   
    First = LBound(TempArray)
    Last = UBound(TempArray) - 1
   
    For i = First To Last
        TempArray(i) = LB.List(i)
    Next i
   
    For i = First To Last
        For j = i + 1 To Last
            If TempArray(i) > TempArray(j) Then
                Temp = TempArray(j)
                TempArray(j) = TempArray(i)
                TempArray(i) = Temp
            End If
        Next j
    Next i
   
    LB.Clear
    For i = First To Last
        LB.AddItem TempArray(i)
    Next i
End Sub




Nouvelle macro (editeur visual basic), permettant d'insérer ou éditer un tableau Catia via Excel
avec un tableau contenant les colonnes N°plan, indice, nombre, désignation et Observation
A adapter suivant vos besoins, et me demander si vous voulez changer le nombre de colonnes et les tailles si vous n'arrivez pas à déchiffrer toutes la macro.

Attention, lors du passage de Excel vers catia, il y a une vérification de l'existence de la case contenant "N°Plan" dans la colonne A, donc il faut changer cette vérification si vous changez le nom de cette case

Attention pour un bon focntionnement il faut autoriser Excel à recevoir du code depuis catia
Dans le menu Excel "outils" -> "Macro" -> "Securité" -> "Editeur approuvée"
cochez la case "Faire confiance au projet Visual Basic

Code:


Sub CATMain()
'--- initialisation objet nomenclateur
    Dim drawingDocument1 As DrawingDocument
    Dim drawingSheets1 As DrawingSheets
    Dim drawingSheet1 As DrawingSheet
    Dim drawingViews1 As DrawingViews
    Dim drawingView1 As DrawingView
    Dim drawingTables1 As DrawingTables
    Dim nomenclature As DrawingTable
    Set drawingDocument1 = Catia.ActiveDocument
    Set drawingSheets1 = drawingDocument1.Sheets
    Set drawingSheet1 = drawingSheets1.Item("Calque.1")
    Set drawingViews1 = drawingSheet1.Views
    Set drawingView1 = drawingViews1.Item("Main View")
    Set drawingTables1 = drawingView1.Tables
'---- test si un taleau existe si non on le créé
    On Error Resume Next
    Set nomenclature = drawingTables1.Item(1)
    If Err.Number <> 0 Then
        Set nomenclature = drawingTables1.Add(0, 0, 1, 5, 7, 200 / 5)
        With nomenclature
            .SetCellString 1, 1, "N°Plan"
            .SetCellString 1, 2, "Ind."
            .SetCellString 1, 3, "Nb"
            .SetCellString 1, 4, "Désignation"
            .SetCellString 1, 5, "Observations"
            .SetColumnSize 1, 28
            .SetColumnSize 2, 10
            .SetColumnSize 3, 10
            .SetColumnSize 4, 76
            .SetColumnSize 5, 76
            For C = 1 To 5
                With .GetCellObject(1, C)
                    .SetFontSize 0, 0, 2.3
                End With
            Next
        End With
    End If
'---- initialisation variables de traiement
    Dim colonnes As Long
    Dim lignes As Long
    colonnes = nomenclature.NumberOfColumns
    lignes = nomenclature.NumberOfRows
'---- initialisation excel
    Dim Excel As Object
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set Excel = CreateObject("Excel.Application")
        Excel.Visible = True
    End If
    On Error GoTo 0
    Excel.Visible = True
    Excel.Workbooks.Add
    Set wbks = Excel.ActiveWorkbook
    Set wbk = wbks.Sheets(1)
'------- passage catia -> excel
    For L = 1 To lignes
        For C = 1 To colonnes
            wbk.Cells(L, C) = nomenclature.GetCellString(L, C)
            wbk.Cells(L, C).borders.LineStyle = 1
            wbk.Cells(L, C).borders.Weight = 2
        Next
    Next
'------ mis en page excel
    wbk.Columns(1).ColumnWidth = 14.29
    wbk.Columns(2).ColumnWidth = 2.57
    wbk.Columns(3).ColumnWidth = 4.43
    wbk.Columns(4).ColumnWidth = 42.71
    wbk.Columns(5).ColumnWidth = 30.71
'---- initialisation bouton de mise à jour excel
    Dim Obj As Object
    Dim Code As String
'---- create button
    Set Obj = wbk.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=550, Top:=0, Width:=100, Height:=35)
    Obj.Name = "Bouton_MAJ"
'---- buttonn text
    wbk.Bouton_MAJ.Caption = "Mise à jour de la nomenclature"
    wbk.Bouton_MAJ.WordWrap = True
    wbk.Bouton_MAJ.TakeFocusOnClick = False
'---- macro text
    Code = Code & "Private Sub Bouton_MAJ_Click()" & vbCrLf
    Code = Code & " " & vbCrLf
    Code = Code & "'---- initialisation catia" & vbCrLf
    Code = Code & "    Dim Catia As Object" & vbCrLf
    Code = Code & "    On Error Resume Next" & vbCrLf
    Code = Code & "    Set Catia = GetObject(, ""CATIA.Application"")" & vbCrLf
    Code = Code & "    If Err.Number <> 0 Then" & vbCrLf
    Code = Code & "        MsgBox (""pas de session catia trouvée"")" & vbCrLf
    Code = Code & "    Else" & vbCrLf
    Code = Code & "        On Error GoTo 0" & vbCrLf
    Code = Code & "        Set drawingDocument1 = Catia.ActiveDocument" & vbCrLf
    Code = Code & "        Set drawingSheets1 = drawingDocument1.Sheets" & vbCrLf
    Code = Code & "        Set drawingSheet1 = drawingSheets1.Item(""Calque.1"")" & vbCrLf
    Code = Code & "        Set drawingViews1 = drawingSheet1.Views" & vbCrLf
    Code = Code & "        Set drawingView1 = drawingViews1.Item(""Main View"")" & vbCrLf
    Code = Code & "        Set drawingTables1 = drawingView1.Tables" & vbCrLf
    Code = Code & "        Set nomenclature = drawingTables1.Item(1)" & vbCrLf
    '--Code = Code & "        nomenclature.ComputeMode = CatTableComputeOFF" & vbCrLf
    Code = Code & "'---- determine nom de ligne de la nomenclature" & vbCrLf
    Code = Code & "        Dim l, lignes As Long" & vbCrLf
    Code = Code & "        l = 1" & vbCrLf
    Code = Code & "        While Cells(l, 1) <> ""N°Plan""" & vbCrLf
    Code = Code & "            l = l + 1" & vbCrLf
    Code = Code & "            if l>150 then" & vbCrLf
    Code = Code & "                MsgBox (""case 'N°Plan' non trouvée"")" & vbCrLf
    Code = Code & "                Exit Sub" & vbCrLf
    Code = Code & "            end if" & vbCrLf
    Code = Code & "        Wend" & vbCrLf
    Code = Code & "'---- lit taille de la nomenclature existante" & vbCrLf
    Code = Code & "        lignes = nomenclature.NumberOfRows" & vbCrLf
    Code = Code & "'---- redimentionna la nomenclature Catia" & vbCrLf
    Code = Code & "        If lignes < l Then" & vbCrLf
    Code = Code & "            lignes = l - lignes" & vbCrLf
    Code = Code & "            For t = 1 To lignes" & vbCrLf
    Code = Code & "                nomenclature.AddRow 0" & vbCrLf
    Code = Code & "                nomenclature.Y = nomenclature.Y + 7" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        Else" & vbCrLf
    Code = Code & "            lignes = lignes - l" & vbCrLf
    Code = Code & "            For t = 1 To lignes" & vbCrLf
    Code = Code & "                nomenclature.RemoveRow 0" & vbCrLf
    Code = Code & "                nomenclature.Y = nomenclature.Y - 7" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        End If" & vbCrLf
    Code = Code & "'---- passage excel -> Catia" & vbCrLf
    Code = Code & "        For ligne = 1 To l" & vbCrLf
    Code = Code & "            For colonne = 1 To 5" & vbCrLf
    Code = Code & "                nomenclature.SetCellString ligne, colonne, Cells(ligne, colonne)" & vbCrLf
    Code = Code & "            Next" & vbCrLf
    Code = Code & "        Next" & vbCrLf
    '---Code = Code & "        nomenclature.ComputeMode = CatTableComputeON" & vbCrLf
    Code = Code & "        thisworkbook.Close SaveChanges:=False" & vbCrLf
    Code = Code & "    End If" & vbCrLf
    Code = Code & "End Sub" & vbCrLf
'---- add macro at the end of the sheet module
    With wbks.VBProject.VBComponents(wbk.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
    nomenclature.ComputeMode = CatTableComputeON
End Sub


Ho Ho Ho...

J'ai pas de temps en ce moment pour m'y pencher dessus, mais j'y jeterai un oeil Guss. Ca m'a l'air tout bon pour mes ptits plans ça !

Merci pour ton travail !

ça évite de passer par les objet OLE et d'être limité à une 50aine de ligne lors de l'importation d'un tableau Excel

Ouah merci du partage Guss!!

Je teste ca dés que j'ai 5 minutes

De rien j'ai vu plusieurs fois ce genre de soucis avec d'autre qui répondaient qu'ils avaient un script qu'il ne voulaient pas partager.
Donc s'ils avaient été capable de le faire, pourquoi pas moi

Quelqu'un connait il le module knowledge expert ? car j'ai besoin d'explication, en effet, je voudrais créer une règle qui ressemblerai à :
en CATscript
if Longueur.1 <= Longueur.2
time =1s

en VBScript
if Longueur.1< Longueur.2 then
time =1s
end if
if longueur.1=Longueur.2 then
time =1s
end if

avec Longueur 1 et 2, 2 paramètres en mm
et time un paramètre en seconde

C’est l’atelier Knowlegde Advisor qu’il faut que tu utilises.

Voici la formule en CatScript :

If Longueur_1 <= Longueur_2
Time_1 =10s

Tu as testé les lignes que tu avais mis?car ca me semble relativement similaire. A mon avis ca devait marcher

Oui je connais ce module, mais le problème est que je ne peut pas l'utiliser car il n'est pas installé, en effet, j'utilise LMS Virtual.lab (logiciel de simulation dynamique compatible avec catia : certain module sont identique) mais je n'ai accès qu'à Knowledge expert et non advisor. Mais Expert est bien plus compliqué à utiliser.

Salut à tous !
j'ai besoin d'un petit coup de pouce pour du vbscript (en effet je gère assez bien vba mais je bloque en vbscript !)

En fait j'ai réalisé une pièce paramétrée à partir d'un fichier Excel et j'ai besoin de récupérer la valeur de ce parametre pour enregistrer mon fichier
Concrétement

j'ai un arbre principal nommé "Parameters", un sous-arbre nommé "Dimensions" qui contient plusieurs paramètres donc "PartNumber"
PartNumber est le nom de ma pièce (EX: moteur_V8)

je voudrais créer une petite macro qui me permette de renommer mon Part1.CATPart en PartNumber.CATPart, est-ce possible ?
(de récupérer la valeur d'un paramètre)
Merci bien

Tu veux changer le nom de fichier ou bien changer le nom du produit en haut de l'arborescence ?

La methode exportdata permet d'enregister ton document avec le nom que ut désire


Sub ExportData ( fileName As String, format As String)

Merci Guss de ta réponse
Je crois que j'ai besoin d'utiliser les 2 propositions lol

En fait je voulais changer le nom du fichier (le .CATPart) et le renommer à partir de la valeur de mon paramètre PartNumber.
De meme pour le nom du produit en haut de l'arborescence, je vais tester tout ca

Pour changer le nom de ta part

Code:


Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

partDocument1.Product.Name = PartNumber

Moi j'utilise celle la:

Code:

Language=\"CATSCRIPT\"

Sub CATMain()

Dim partDocument1 As Document

Set partDocument1 = CATIA.ActiveDocument

Dim product1 As Product

Set product1 = partDocument1.Product

i=PartDocument1.Name

k=left (i,(len(i)-8))

Set part1 = partDocument1.Part

Product1.PartNumber =k

End Sub

Pour renommer le nom de ma part Catia, en fonction du nom enregistré dans Windows mais en enlevant l'extension .Catpart

Merci Guss pour ta macro de création de nomenclature

salut guss,

J'ai repris ta macro et je l'ai modifier pour qu'elle m'ouvre un classeur existant plutot que d'en créer un,
histoire de mettre directement un tableau existant.
Le problème c'est que j'ai une erreur a la première ligne du code ci dessous (sans compter le commentaire)
du type: run time error 9: l'indice n'appartient pas a la selection.

Code:


'---- add macro at the end of the sheet module
    With wbks.VBProject.VBComponents(wbk.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
    nomenclature.ComputeMode = CatTableComputeON
End Sub


[/quote]Je ne comprend pas pourquoi si j'ouvre un fichier existant ca ne marche pas, alors que si j'en créer un ca marche.
les modifications que j'ai fait sont ci dessous:

Code:


'---- initialisation excel
    Dim Excel As Object
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set Excel = CreateObject("Excel.Application")
        Excel.Visible = True
    End If
    On Error GoTo 0
    Excel.Visible = True
        ' Test to see if the file is open.
If IsFileOpen("C:\Users\cylefebvre\appliplac\DIABLO7\Appliplac9.xls") Then
    Set wbks = Excel.ActiveWorkbook
    Set wbk = wbks.Sheets("Faisceau")
Else
     Set wbExcel = Excel.workbooks.Open("C:\Users\cylefebvre\appliplac\DIABLO7\Appliplac9.xls")
     Set wbks = Excel.ActiveWorkbook
    Set wbk = Worksheets("Faisceau")
End If
'------- passage catia -> excel


Merci d'avance de votre aide

Bonjour,

J'ai lu le code de Guss pour créer un tableau (merci d'ailleurs!). Je m'intéresse ici uniquement à la partie création d'un tableau dans Catia sur les planches à dessin.
Je me demandais s'il était possible de créer un tableau non pas en utilisant les coordonnées de l'endroit où l'on veut le placer mais en attendant que l'utilisateur clique à un endroit avec la souris pour le placer à l'endroit cliqué ( comme si on créé le tableau en utilisant Insertion->Annotations->tableau).

Merci !

J'imagine que c'est possible, il faut dans un 1er temps attendre un événement utilisateur (je n'ai plus en tête quelle fonction il me semble qu'il y a des exemple qui ressemble à ce dont tu as besoin dans l'aide)
Ensuite il faut récupérer les coordonnées du curseur pour placer le tableau.

Merci Guss pour ton script. il m’intéresse beaucoup, mais il plante à cette endroit:

Code:


'---- add macro at the end of the sheet module
    With wbks.VBProject.VBComponents(wbk.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
    nomenclature.ComputeMode = CatTableComputeON
End Sub


je l'ai enregistré en .catvba, est-ce que ça peut venir de là?