Récupér des coordonnées de point en draw ou sketch

Faut utiliser la fonction getcoordinate()

Par contre il faut définir des objets des passage, tu ne peux pas effectuer cette fonction directement sur ton objet de sélection.

Code:


            Dim oposition As Object
            Set oposition = produit_parent.Products.Item(A).position
            '-- chercher ici les points à récupéré dans la pièces séléctionée.
            Dim part_select As Part
            Set part_select = Documents.Item(nom_base & "CATPart").Part
            Dim prod_select As Product
            Set prod_select = Documents.Item(nom_base & "CATPart").Product
            Dim hbodies As HybridBodies
            Set hbodies = part_select.HybridBodies
            Dim hbody As HybridBody
            Set hbody = hbodies.Item("points_clef")
            Dim oshapes As HybridShapes
            Set oshapes = hbody.HybridShapes
           
            Dim I
            For I = 1 To oshapes.Count Step 1
                If TypeName(oshapes.Item(I)) = "HybridShapePointCoord" Or TypeName(oshapes.Item(I)) = "HybridShapePointExplicit" Then
                    Dim point(2)
                    oshapes.Item(I).GetCoordinates point 'extraction de coordonées point dans le repère pièce

Dasn cette extrait de mon code, par exemple je ne pouvait pas ecrire


hbody.HybridShapes.Item(I).GetCoordinates point

Qui permettait d'aller extraire des coordonnées (3d) d'un point, on ne peut visiblement pas utiliser la fonction comme ça.
J'ai été obligé de définir l'objet sur-lequel je veux effectuer getcoordinate()

Dim oshapes As HybridShapes
Set oshapes = hbody.HybridShapes
oshapes.Item(I).GetCoordinates point

En fait les coordonnées sont un objet à par entière également, c'est assez lourd comme construction, il y a des ramification partout et on ne peut pas accéder à toutes les information lié à un un objet de manière toujours identiques, suivant l'info qu'on veut en tirer.

tu noteras que pour Dim point(2) je n'ai pas noté Dim point(2) as point

Je ne sais pas trop pourquoi mais vb ne veux pas que je définisse cette variable comme étant un point, si je le fait au niveau du getcoordinaite() j'obtiens un erreur (alors que dans le debug vb définie bien point(2) comme étant un point )

Salut,

Je me suis penché sur ton problème, car peut potentiellement m'intéresser


essaye ce code

Code:


Sub CATMain()

    Dim activedoc As Document
    Set activedoc = CATIA.ActiveDocument
    Dim ainformations()
    Dim apointcoordinates(2)
    Dim oselection As Object, opoint As Object
    Dim ilength, i
   
   
    Set oselection = activedoc.selection
    oselection.Clear ' met à zero l'objet de séléction
    oselection.Search ("CATDrwSearch.2DGeometry,all") 'recherche dans tout le document actif les élément de géométrie 2D
    ilength = oselection.Count 'compte ne nombre d'objet séléctioner
   
   
    ReDim ainformations(1 To ilength, 0 To 3)
 
    For i = 1 To ilength
    Set opoint = oselection.Item(i).Value
    ainformations(i, 0) = opoint.Name
    ainformations(i, 1) = opoint.GeometricType
        If opoint.GeometricType = 2 Then 'discrimine les poitn des autres éléments 2D
            opoint.GetCoordinates apointcoordinates
            ainformations(i, 2) = apointcoordinates(0)
            ainformations(i, 3) = apointcoordinates(1)
        End If
    Next
   
    For i = 1 To UBound(ainformations)
        MsgBox "Nom = " & ainformations(i, 0) & Chr(13) & "type = " & ainformations(i, 1) & Chr(13) & "X= " & ainformations(i, 2) & Chr(13) & "Y= " & ainformations(i, 3)
    Next
   
End Sub

Salut Guss, je reprends le sujet ce matin.

Je suis en train d'intégrer une partie de ce que tu as fait et de ce que j'avais fait.
Ça donne ça pour le moment :

Sub Recup_Un_Point()

Dim ainformations(1, 3)
Dim apointcoordinates(2)
Dim oselection As Object, opoint As Object
Dim Selection1 As Object
Set Selection1 = CATIA.ActiveDocument.Selection

Dim InPutObjectType(0)
InPutObjectType(0) = "Point2D"
Status = Selection1.SelectElement2(InPutObjectType, "Select a point", False)

Set opoint = Selection1.Item(1).Value
opoint.GetCoordinates apointcoordinates
ainformations(1, 0) = opoint.Name
'ainformations(1, 1) = opoint.GeometricType
ainformations(1, 2) = apointcoordinates(0)
ainformations(1, 3) = apointcoordinates(1)

MsgBox "Nom = " & ainformations(1, 0) & Chr(13) & Chr(13) & "X= " & ainformations(1, 2) & Chr(13) & "Y= " & ainformations(1, 3)

End Sub


Donc tu m'as bien fait avancer ! MERCI.

Je continue et finalise la macro et mets ça en ligne.

Merci.

Fred

Ça y est je touche au but !

---

Code:


Sub Creation_Gabarit()

' macro realisee par xx
' xx
' par Frederic Blanchard
' Le 22/10/2012

' OBJECTIF : recuperer des points sur un drawing
' et les exporter dans un fichier Gabarit.txt

'-----------------------------------------

' init variables

    Dim ainformations(1, 3)
    Dim apointcoordinates(2)
    Dim oselection As Object, opoint As Object
    Dim Selection1 As Object
    Set Selection1 = CATIA.ActiveDocument.Selection
    Dim Num_Pts As Integer
    Dim Premier_Point(2)
    Dim Test_premier_Point As Integer

 
    Premier_Point(1) = -1000
    Premier_Point(2) = -1000
    Num_Pts = 1
    Test_premier_Point = 0
 
'-----------------------------------------

' ouverture fichier Gabarit.txt

    Set filesys = CATIA.FileSystem
    Dim FileName As String
    FileName = "C:\temp\Gabarit.txt"

    Dim FilIn As File
    Set FilIn = filesys.CreateFile(FileName, True)
    Set ostream = FilIn.OpenAsTextStream("ForWriting")
   
    ostream.Write (Chr(34) & " gabarit" & Chr(10))
    ostream.Write (Chr(10))
    ostream.Write (Chr(10))
    ostream.Write (" Point de calage = 1" & Chr(10))
    ostream.Write (Chr(10))
    ostream.Write (Chr(10))
   
'-----------------------------------------
 
' selection premier point

    MsgBox "Le premier point est le point de reference"
   
    ' select point

    Dim InPutObjectType(0)
    InPutObjectType(0) = "Point2D"
    Status = Selection1.SelectElement2(InPutObjectType, "Select a point", False)

' extraction coordonnees

    Set opoint = Selection1.Item(1).Value
    opoint.GetCoordinates apointcoordinates
    ainformations(1, 0) = opoint.Name
    ainformations(1, 2) = apointcoordinates(0)
    ainformations(1, 3) = apointcoordinates(1)

    Premier_Point(1) = ainformations(1, 2)
    Premier_Point(2) = ainformations(1, 3)

' export premier point

    ostream.Write (Num_Pts & Chr(9) & 0 & Chr(9) & 0 & Chr(10))


'-----------------------------------------

' boucle sur tous les points


MsgBox "Selection des autres points"

Do While Test_premier_Point = 0

' select point

'    Dim InPutObjectType(0)
    InPutObjectType(0) = "Point2D"
    Status = Selection1.SelectElement2(InPutObjectType, "Select a point", False)

' extraction coordonnees

    Set opoint = Selection1.Item(1).Value
    opoint.GetCoordinates apointcoordinates
    ainformations(1, 0) = opoint.Name
    ainformations(1, 2) = apointcoordinates(0)
    ainformations(1, 3) = apointcoordinates(1)
   
' selection premier point = point de reference

    If (ainformations(1, 2) = Premier_Point(1)) + (ainformations(1, 3) = Premier_Point(2)) Then
        Test_premier_Point = 1
    End If
   
    Num_Pts = Num_Pts + 1

' export point
   
    ostream.Write (Num_Pts & Chr(9) & Round(ainformations(1, 2) - Premier_Point(1), 4) & Chr(9) & Round(ainformations(1, 3) - Premier_Point(2), 4) & Chr(10))


Loop

'-----------------------------------------

' fin de boucle et

    ostream.Close

    MsgBox "Fin de script"
    MsgBox "La fichier Gabarit.txt a ete cree dans le repertoire C:\Temp"
   
End Sub

Dernier chantier : rendre l'exécution pour les dessinateurs simple sans passer par le vba mais par un appui simple sur un bouton ou un truc du genre.

ça c'est simple
Tu charges la macro dans les bibliothèques (bref faut qu'elle soit accessible comme quand tu l'édites)

Tu vas dans personnaliser la barre d'outils (clic droit sur la barre d'outils -> personnaliser ...
dans "barre d'outils" tu peut te créé une nouvelle barre d'outils pour tes macros
dans "commandes" dans la colonne de gauche tu sélectionnes 'Macros"
dans la colonne de droite tu glisse la macro que tu veux vers la barre d'outils que tu veux.

Ben ce que tu dis je l'ai fait mais ça ne lance pas la macro.
Pour ça il faut que j'aille dans le vba pour lancer la macro en appuyant sur l'icône de lecture ( > ) ...
Peut-être parce que j'ai 2 modules ? Un principal et l'autre pour des fonctions connexes( affichage, ouverture explorateur, ouverture d'un fichier txt ).

tu as le choix des modules que tu as créé normalemnt dans ta macro, ensuite ça lance le Sub catmain() en 1er
du coup si cette routine n'existe pas dans ton module ça ne se lancera pas

OK c'est fait et ça marche.

Fred