Discussion :

[familledacp]

Bonjour à tous et à toutes

Je cherche à extraire des données dans un fichier texte de type dxf (il s'agit d'un format d'export d'autocad)

Les fichiers sont composés d'une succession de lignes et parfois très longs

J'en ai par exemple généré un qui fait 1 350 000 lignes.....

Je cherche à récupérer les lignes concernant un certain type de données et les insérer dans un fichier excel pour ensuite les retraiter

Il s'agit des lignes avec le texte "AcDbPolyline"

C'est ce que j'arrive à obtenir dans le code ci dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub CommandButton4_Click()
 Dim ValeurLigne As String
  Dim Cellule As Range
 
  Set Cellule = Range("a2")
 
  Open "e:\dessin1.dxf" For Input As #1
  Do While Not EOF(1)
  Line Input #1, ValeurLigne
  If InStr(1, ValeurLigne, "AcDbPolyline") <> 0 Then
    Cellule = ValeurLigne
    Set Cellule = Cellule(2)
  End If
  Loop
  Close #1
 
End Sub

Je souhaite aller plus loin

A chaque fois qu'on trouve "AcDbPolyline", il faut récupérer
- la valeur située deux lignes au dessus (par exemple "essai calque" dans le fichier joint)
- les valeurs numériques situées sur la 8e ligne en dessous et toutes les 2 lignes juqu'à la 1ere ligne avec un mot (et non des valeurs numériques). Le nombre de lignes concernées varie d'un "paragraphe à l'autre)

Je mets à titre d'exemple un fichier dxf en pièce jointe.

Si vous avez des pistes, je suis preneur, et vous en remercie par avance.

Bonne journée

Daniel S

[AlainTech]

Bonjour,

Une idée:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
  Dim Cellule As Range
  Dim strLigneMoins1 As String
  Dim strLigneMoins2 As String
  Dim ValeurLigne As String
 
  Set Cellule = Range("a2")
 
  Open ThisWorkbook.Path & "\dessin1.dxf" For Input As #1
  Do While Not EOF(1)
    Line Input #1, ValeurLigne
    If InStr(1, ValeurLigne, "AcDbPolyline") <> 0 Then
      Cellule = ValeurLigne
      Cellule.Offset(0, 1) = strLigneMoins2
      Cellule.Offset(0, 2) = strLigneMoins1
      Set Cellule = Cellule(2)
    End If
    strLigneMoins2 = strLigneMoins1
    strLigneMoins1 = ValeurLigne
  Loop
  Close #1

[Qwazerty]

Salut

J'ai poursuivi le code d'AlainTech

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
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
Sub teste()
  Dim Cellule As Range
  Dim strLigneMoins1 As String
  Dim strLigneMoins2 As String
  Dim ValeurLigne As String
  Dim ValeurAfterHeight As Variant
  Dim iEight As Integer
  Dim SheetResult As Worksheet
 
  Set SheetResult = ThisWorkbook.Sheets("Feuil1")
 
  Set Cellule = SheetResult.Range("a2")
  iEight = -1
 
  Open ThisWorkbook.Path & "\dessin1.dxf" For Input As #1
  Do While Not EOF(1)
    Line Input #1, ValeurLigne
 
    'Si on est en cours de recherche de la 8ème ligne
    If iEight > -1 Then iEight = iEight + 1
 
    If InStr(1, ValeurLigne, "AcDbPolyline") <> 0 Then
      Cellule = ValeurLigne
      Cellule.Offset(0, 1) = strLigneMoins2
      'Cellule.Offset(0, 2) = strLigneMoins1
      'Set Cellule = Cellule(2)
      iEight = 0
    End If
    strLigneMoins2 = strLigneMoins1
    strLigneMoins1 = ValeurLigne
 
    'On regarde si on a atteint la 8ème ligne ou une ligne paire suivant 8
    If (iEight >= 8) And (iEight Mod 2 = 0) Then
        'On verifie qu'une valeur numérique soit contenu (attention avec le séparateur numérique)
        'Par contre ici je suppose que les valeur ne prennent jamais 0 comme valeur (fait signe si ça ne va pas)
        If CStr(Val(ValeurLigne)) <> "0" Then
            'On a une valeur numérique
            SheetResult.Cells(Cellule.Row, Columns.Count).End(xlToLeft).Offset(0, 1) = ValeurLigne
        Else
            'La valeur n'est pas numérique, on stoppe la recherche
            iEight = -1
            'On passe à la ligne suivante
            Set Cellule = SheetResult.Cells(Cellule.Row + 1, "A")
        End If
    End If
 
  Loop
  Close #1
 
  End Sub

++
Qwaz

[familledacp]

Bonjour à tous et toutes

Un énorme merci à AlainTech et Qwazerty

Je suis bluffé

Une précision complémentaire : il se peut qu'il y ait des valeurs "0" sur les coordonnées des polylignes à récupérer .... Il se peut aussi qu'il y ait des valeurs négatives aussi, mais ca, mon traitement ensuite sait les gérer (tableau croisé dynamique)

Sans abuser, s'il était possible de faire une petite modification, j'en serais très heureux ... si cela vous ennuie, je m'y plongerai .

Dans le cas de polylignes composées de plusieurs segments, le code que qwazerty a posté met les résultats sur une même ligne

S'il était possible de les décomposer sur plusieurs lignes (comme sur le tableau ci joint), cela serait super

Encore merci pour votre implication


Bonne journée

Daniel S

[did85]

Bonjour,
je ne sais pas si tu as plus de 6 segments. J'ai modifié le code que Qwazerty t'a passé pour ajouter uniquement 6 segments.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
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
Sub test()
  Dim Cellule As Range
  Dim strLigneMoins1 As String
  Dim strLigneMoins2 As String
  Dim ValeurLigne As String
  Dim ValeurAfterHeight As Variant
  Dim iEight, iNbColonne As Integer
  Dim SheetResult As Worksheet
 
  Set SheetResult = ThisWorkbook.Sheets("Feuil1")
 
  Set Cellule = SheetResult.Range("a2")
  iEight = -1
 
  Open ThisWorkbook.Path & "\Dessin1.dxf" For Input As #1
  Do While Not EOF(1)
    Line Input #1, ValeurLigne
 
    'Si on est en cours de recherche de la 8ème ligne
    If iEight > -1 Then iEight = iEight + 1
 
    If InStr(1, ValeurLigne, "AcDbPolyline") <> 0 Then
      Cellule = ValeurLigne
      Cellule.Offset(0, 1) = strLigneMoins2
      'Cellule.Offset(0, 2) = strLigneMoins1
      'Set Cellule = Cellule(2)
      iEight = 0
    End If
    strLigneMoins2 = strLigneMoins1
    strLigneMoins1 = ValeurLigne
 
    'On regarde si on a atteint la 8ème ligne ou une ligne paire suivant 8
    If (iEight >= 8) And (iEight Mod 2 = 0) Then
        'On verifie qu'une valeur numérique soit contenu (attention avec le séparateur numérique)
        'Par contre ici je suppose que les valeur ne prennent jamais 0 comme valeur (fait signe si ça ne va pas)
        If CStr(Val(ValeurLigne)) <> "0" Then
            'On a une valeur numérique
            'Récupère le numéro de la dernière colonne remplie pour faire un tableau sur 4 colonnes
            iNbColonne = SheetResult.Cells(Cellule.Row, Columns.Count).End(xlToLeft).Column
            'On a atteint le quota de segment, on change de ligne
            If iNbColonne >= 6 Then
                Set Cellule = SheetResult.Cells(Cellule.Row + 1, "A")
                'On recopie la ligne du dessus
                SheetResult.Cells(Cellule.Row, 1) = SheetResult.Cells(Cellule.Row - 1, 1)
                SheetResult.Cells(Cellule.Row, 2) = SheetResult.Cells(Cellule.Row - 1, 2)
                SheetResult.Cells(Cellule.Row, 4) = SheetResult.Cells(Cellule.Row - 1, iNbColonne)
                SheetResult.Cells(Cellule.Row, 3) = SheetResult.Cells(Cellule.Row - 1, iNbColonne - 1)
                iNbColonne = 4
            End If
            'On n'a pas atteint le quota de segments
            SheetResult.Cells(Cellule.Row, iNbColonne + 1) = ValeurLigne
        Else
            'La valeur n'est pas numérique, on stoppe la recherche
            iEight = -1
            'On passe à la ligne suivante
            Set Cellule = SheetResult.Cells(Cellule.Row + 1, "A")
        End If
    End If
 
  Loop
  Close #1
 
  End Sub

Si tu as besoin de modifier la présentation, c'est ici que ça se passe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 'Récupère le numéro de la dernière colonne remplie pour faire un tableau sur 4 colonnes
            iNbColonne = SheetResult.Cells(Cellule.Row, Columns.Count).End(xlToLeft).Column
            'On a atteint le quota de segment, on change de ligne
            If iNbColonne >= 6 Then
                Set Cellule = SheetResult.Cells(Cellule.Row + 1, "A")
                'On recopie la ligne du dessus
                SheetResult.Cells(Cellule.Row, 1) = SheetResult.Cells(Cellule.Row - 1, 1)
                SheetResult.Cells(Cellule.Row, 2) = SheetResult.Cells(Cellule.Row - 1, 2)
                SheetResult.Cells(Cellule.Row, 4) = SheetResult.Cells(Cellule.Row - 1, iNbColonne)
                SheetResult.Cells(Cellule.Row, 3) = SheetResult.Cells(Cellule.Row - 1, iNbColonne - 1)
                iNbColonne = 4
            End If
            'On n'a pas atteint le quota de segments
            SheetResult.Cells(Cellule.Row, iNbColonne + 1) = ValeurLigne

Il faudrait que tu redonnes un .dxf plus complexe pour voir si ça colle.
Bon appétit.
Did85

[familledacp]

Re bonjour

Voici en pièce jointe un fichier dxf avec 2 polylignes, une de 12 segments, une de 6

Bon appétit

A bientot

Daniel S