Macro coordonnées X Y Z sur drawing

Bonjour,

Je vous partage un code qui permet de créer des points sur un Drawing via un programme G-Code.
Prérequis :

• Avoir un Userform nommé "UserForm7"
  
• Une TextBox1 avec l'option MultiLigne activée
  
• Une Listbox1 et Listbox2
  
• Un CommandButton1 avec l'option Enabled = false
  
• Un CommandButton2
  
• Une Checkbox1
  
• Une Textbox2
  

Votre UserForm7 devrait ressembler à ça :



Voici la macro à coller directement dans le code de l'UserForm7 :

Code:

Private Sub CommandButton1_Click()
If ListBox1.ListCount = 0 Then
Exit Sub
End If

'Declarations
Dim DrwDocument   As DrawingDocument
Dim DrwSheets     As DrawingSheets
Dim DrwSheet      As DrawingSheet
Dim DrwView       As DrawingView
Dim DrwTexts      As DrawingTexts
Dim Text          As DrawingText
Dim Fact          As Factory2D
Dim Point         As Point2D
Dim Line          As Line2D
Dim Cicle         As Circle2D
Dim Selection     As Selection
Dim GeomElems     As GeometricElements
Dim tblTable As DrawingTable


  Set DrwDocument = CATIA.ActiveDocument
  Set DrwSheets = DrwDocument.Sheets
  Set Selection = DrwDocument.Selection
  Set DrwSheet = DrwSheets.ActiveSheet
  Set DrwView = DrwSheet.Views.ActiveView
  Set DrwTexts = DrwView.Texts
  Set Fact = DrwView.Factory2D
  Set GeomElems = DrwView.GeometricElements
Set tblTable = DrwView.Tables.Add(500, 500, ListBox1.ListCount + 1, 4, 10, 20)
tblTable.Name = "Coordonnées X Y"
tblTable.SetCellString 1, 1, "REP"
tblTable.SetCellString 1, 2, "X"
tblTable.SetCellString 1, 3, "Y"
tblTable.SetCellString 1, 4, "R"

If CheckBox1.Value = False Then
'positionnement du point
For i = 0 To ListBox1.ListCount - 1
    CoorX = ListBox1.List(i)
    CoorY = ListBox2.List(i)
    Set Point1 = Fact.CreatePoint(CoorX, CoorY)
    Set Text1 = DrwSheets.ActiveSheet.Views.ActiveView.Texts.Add("" & i + 1, CoorX, CoorY)
    Point1.Name = "Pt" & i
    Set selection2 = DrwDocument.Selection
    selection2.Clear
    selection2.Add Point1
    Set VisPropSet1 = selection2.VisProperties
    VisPropSet1.SetRealColor 255, 255, 0, 1
    selection2.Clear
Next i
Else
If TextBox2.Text = "" Then
Exit Sub
End If


For i = 0 To ListBox1.ListCount - 1
    CoorX = ListBox1.List(i)
    CoorY = ListBox2.List(i)
    Set Point1 = Fact.CreatePoint(CoorX, CoorY)
    Set Circle1 = DrwSheets.ActiveSheet.Views.ActiveView.Factory2D.CreateCircle(CoorX, CoorY, TextBox2.Value / 2, 0, 4 * Pi)
    Set Text1 = DrwSheets.ActiveSheet.Views.ActiveView.Texts.Add("" & i + 1, CoorX, CoorY)
    Circle1.Name = "Cer" & i
    Set selection2 = DrwDocument.Selection
    selection2.Clear
    selection2.Add Circle1
    selection2.Add Point1
    Set VisPropSet1 = selection2.VisProperties
    VisPropSet1.SetRealColor 255, 255, 0, 1
    selection2.Clear

    
Next i
End If

For N = 2 To ListBox1.ListCount + 1
tblTable.SetCellString N, 1, N - 1
tblTable.SetCellString N, 2, ListBox1.List(N - 2)
tblTable.SetCellString N, 3, ListBox2.List(N - 2)
Next


End Sub

Private Sub CommandButton2_Click()

ListBox1.Clear
ListBox2.Clear
Dim MaValX
Dim MaValY
Dim Tab1() As String 'je déclare une variable tableau virtuel
Tab1 = Split(TextBox1.Text, vbCrLf) 'chaque ligne du tableau virtuel est = à chaque ligne de la textbox

For X = 0 To UBound(Tab1) 'lancement boucle ligne par ligne
If InStr(Tab1(X), "X") > 0 And InStr(Tab1(X), "Y") > 0 Then 'si la ligne contient un "X" ET un "Y"
    If InStr(Tab1(X), "X") > 0 Then 'si la ligne de mon tableau virtuel contient la lettre "X"
        toto = Split(Tab1(X), "X")(1) 'alors la variable toto est égale à tout ce qui se trouve devant X
        For N = 1 To Len(toto) 'je lance une boucle qui va parcourir chaque caractère de la variable toto
            If Left(toto, N) = "-" Then 'si je trouve comme caractère un moins "-"
            N = N + 1 'alors je passe directement au caractère suivant car cela veut dire que la valeur sera négative
            End If
            If Not IsNumeric(Left(toto, N)) Then 'je lis le premier caractère et s'il n'est pas numérique
            toto = Left(toto, N - 1) 'alors la valeur de toto est égale à tout ce qui se trouve avant le caractère non numérique
            Exit For 'et je sors de la boucle pour ne pas lire le reste de la variable car c'est inutile
            End If
        Next 'prochain caractère
        ListBox1.AddItem toto 'j'ajoute la valeur dans la listbox
        
        MaValX = toto 'j'attribu à la variable MaValX la valeur de X
    End If 'nous venons de trouver et isoler la valeur de "X" 8-D

    If InStr(Tab1(X), "Y") > 0 Then 'si la ligne de mon tableau virtuel contient la lettre "Y"
        toto = Split(Tab1(X), "Y")(1) 'alors la variable toto est égale à tout ce qui se trouve devant Y
        For N = 1 To Len(toto) 'je lance une boucle qui va parcourir chaque caractère de la variable toto
            If Left(toto, N) = "-" Then 'si je trouve comme caractère un moins "-"
            N = N + 1 'alors je passe directement au caractère suivant car cela veut dire que la valeur sera négative
            End If
            If Not IsNumeric(Left(toto, N)) Then 'je lis le premier caractère et s'il n'est pas numérique
            toto = Left(toto, N - 1) 'alors la valeur de toto est égale à tout ce qui se trouve avant le caractère non numérique
            Exit For 'et je sors de la boucle pour ne pas lire le reste de la variable car c'est inutile
            End If
        Next 'prochain caractère
        ListBox2.AddItem toto 'j'ajoute la valeur dans la listbox
        
        MaValY = toto 'j'attribu à la variable MaValY la valeur de Y
    End If 'nous venons de trouver et isoler la valeur de "Y" 8-D
End If

If InStr(Tab1(X), "X") > 0 And Not InStr(Tab1(X), "Y") > 0 Then 'si la ligne contient un "X" SANS "Y"
    If InStr(Tab1(X), "X") > 0 Then 'si la ligne de mon tableau virtuel contient la lettre "X"
        toto = Split(Tab1(X), "X")(1) 'alors la variable toto est égale à tout ce qui se trouve devant X
        For N = 1 To Len(toto) 'je lance une boucle qui va parcourir chaque caractère de la variable toto
            If Left(toto, N) = "-" Then 'si je trouve comme caractère un moins "-"
            N = N + 1 'alors je passe directement au caractère suivant car cela veut dire que la valeur sera négative
            End If
            If Not IsNumeric(Left(toto, N)) Then 'je lis le premier caractère et s'il n'est pas numérique
            toto = Left(toto, N - 1) 'alors la valeur de toto est égale à tout ce qui se trouve avant le caractère non numérique
            Exit For 'et je sors de la boucle pour ne pas lire le reste de la variable car c'est inutile
            End If
        Next 'prochain caractère
        ListBox1.AddItem toto 'j'ajoute la valeur dans la listbox
        MaValX = toto 'j'attribu à la variable MaValX la valeur de X
    End If 'nous venons de trouver et isoler la valeur de "X" 8-D
        ListBox2.AddItem MaValY 'vu qu'il y a qu'une valeur en X récupérée, forcément la valeur de Y est celle d'avant

End If

If Not InStr(Tab1(X), "X") > 0 And InStr(Tab1(X), "Y") > 0 Then 'si la ligne contient un "Y" SANS "X"
    If InStr(Tab1(X), "Y") > 0 Then 'si la ligne de mon tableau virtuel contient la lettre "Y"
        toto = Split(Tab1(X), "Y")(1) 'alors la variable toto est égale à tout ce qui se trouve devant Y
        For N = 1 To Len(toto) 'je lance une boucle qui va parcourir chaque caractère de la variable toto
            If Left(toto, N) = "-" Then 'si je trouve comme caractère un moins "-"
            N = N + 1 'alors je passe directement au caractère suivant car cela veut dire que la valeur sera négative
            End If
            If Not IsNumeric(Left(toto, N)) Then 'je lis le premier caractère et s'il n'est pas numérique
            toto = Left(toto, N - 1) 'alors la valeur de toto est égale à tout ce qui se trouve avant le caractère non numérique
            Exit For 'et je sors de la boucle pour ne pas lire le reste de la variable car c'est inutile
            End If
        Next 'prochain caractère
        ListBox2.AddItem toto 'j'ajoute la valeur dans la listbox
        MaValY = toto 'j'attribu à la variable MaValY la valeur de Y
    End If 'nous venons de trouver et isoler la valeur de "Y" 8-D
        ListBox1.AddItem MaValX 'vu qu'il y a qu'une valeur en Y récupérée, forcément la valeur de X est celle d'avant
End If

Next


CommandButton1.Enabled = True


End Sub



Fonctionnement :
Il faut soit coller son programme dans la TextBox1 soit tout simplement écrire des coordonnées X Y ligne par ligne.
Ensuite, en cliquant sur "Extraire coordonnées X et Y", un tri est effectué dans ce qu'on a mit dans la textbox1.
Ce tri va garder uniquement les coordonnées X et Y si on a un programme complexe avec d'autre code (G0, G1, M0, etc...).
Parfois ça bug quand il y a des commentaires entre parenthèse, du genre "G0Y8 (AXE A)" -> vu qu'il y a un "X" dans "AXE" ça bug, mais il suffit d'ajuster à la main son programme.
Le tri est donc effectué dans la listbox1 pour les X et la listbox2 pour les Y.
Une fois ceci fait, 2 options s'offrent à nous :
- si je coche la checkbox "Avec Ø OCO" (OCO = Outil COupant) alors j'indique le Ø dans la textbox2 et cela va créer des cercles aux coordonnées dans les listboxs ;
- si je ne coche rien alors cela va juste créer des points aux coordonnées dans les listboxs.

Enfin, je clique sur "Créer les points sur la vue" et dans notre vue ACTIVE (encadrée en rouge), les points/cercles apparaissent et un tableau récapitulatif est créé.
C'est bien l'origine de la vue active qui sera prise comme référence.

Améliorations possibles :
- Afficher la trajectoire point par point avec une ligne en pointillé ;
- Pouvoir sélectionner un point comme origine plutôt que celle de base dans la vue ;
- Prendre en compte le code G2 ou G3 pour les trajectoires avec rayon (c'est pour ça que dans le tableau que je crée il y a une colonne "R") ;
- Prendre en compte la correction de profil G41 G42 si on coche la checkbox (le point ne sera pas au centre du cercle) ;
- Pouvoir modifier/ajuster les points par la suite.

Flo

Salut
pas encore testé , mais pour les G2 et G3 , il n'y a pas que le "R" il y avoir aussi "I" et "J" ce qui est surement plus facile à traiter