Extraire l'image .JPEG encapuslée dans une pièce .CATPart (CATIA V5)

Invité · 28/04/2016, 11h22

bonjour,
comme j'ai déliré sur 'utilisation de la fonction Bas64, j'a poussé plus loin! alors là ça marche pas mais vraiment 'est rigolo!

le code est un peut long i est fait de brique et de broque!

comme je récupère du texte je peux splitter ( objNode.DataType = "bin.hex")!

Code :

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

1
2
Const Deb = "ffd8": Const Fin = "ffd9"
c = Split(Split(c, Deb)(1), Fin)(0)

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
Function Taille_Fichier(Fichier)
Dim Fso As Object
Dim Fich As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fich = Fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
Set Fso = Nothing
End Function
Function GetBinaryData(Fichier)
Dim Buffer() As Byte
Dim intFileNumber
intFileNumber = FreeFile
ReDim Buffer(Taille_Fichier(Fichier))
Open Fichier For Binary As #intFileNumber
While Not EOF(intFileNumber)
Get #intFileNumber, , Buffer
Wend
GetBinaryData = Buffer
Close #intFileNumber
End Function
Function SetBinaryData(Fichier As String, Buffer)
Dim intFileNumber
intFileNumber = FreeFile
Open Fichier For Binary As #intFileNumber
Put #intFileNumber, , Buffer
Close #intFileNumber
End Function
Private Function EncodeBase32(ByRef arrData() As Byte) As String
    Dim objXML As Object
    Dim objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("ROOT")
    objNode.DataType = "bin.hex"
    objNode.nodeTypedValue = arrData
    EncodeBase32 = objNode.Text
    Set objNode = Nothing
    Set objXML = Nothing
End Function
Private Function DecodeBase32(ByRef arrData As String)
    Dim objXML As Object
    Dim objNode As Object
    Dim b() As Byte
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("ROOT")
    objNode.DataType = "bin.hex"
    objNode.Text = arrData
    DecodeBase32 = objNode.nodeTypedValue
    Set objNode = Nothing
    Set objXML = Nothing
End Function
Private Sub test()
Const Deb = "ffd8": Const Fin = "ffd9"
c = EncodeBase32(GetBinaryData("C:\Users\rdurupt\Desktop\Catpart\Part2.CATPart"))
c = Split(Split(c, Deb)(1), Fin)(0)
c = DecodeBase32(CStr(Deb & c & Fin))
SetBinaryData "C:\Users\rdurupt\Desktop\Catpart\Part2CATPart.JPEG ", c
End Sub

**Thmass33** · 28/04/2016, 13h16

Bonjour,

Je vous fais un retour concernant la conversion de tout un lot de pièces.

Il y a quelques erreurs, je pense que "FFD8" (début JPG) est présent à plusieurs endroits dans certains CATPART.

A mon avis, il faut scanner le fichier entièrement afin de trouver la bonne séquence.

**cerede2000** · 28/04/2016, 13h21

Merci de fournir un CATPart pour lequel tu as ce cas afin qu'on puisse l'analyser

**Thmass33** · 28/04/2016, 13h32

Salut Cerede,

ça va être compliqué de vous founir un catpart complet.

Je pense qu'il faut chercher le "FFD8" (ÿØ) qui est à côté du (JFIF) pour que ça marche à coup sûr

Nom : 02.JPG
Affichages : 268
Taille : 11,8 Ko

**patricktoulon** · 28/04/2016, 16h00

bonjour Rdurupt
est tu sur de ffd8 et ffd9 car chez moi l'image est inexploitable

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
Sub test()
Const Deb = "ffd8": Const Fin = "ffd9"
Dim code As String
code = Deb & Split(Split(EncodeBase32("C:\Users\polux\Desktop\Part2.CATPart"), Deb)(1), Fin)(0) & Fin
r = Base32tofichier(code, "C:\Users\polux\Desktop\mon image.jpg")
End Sub
 
 
 Function EncodeBase32(fichier) As String
Dim OBJstream, BB() As Byte, ok As Boolean, i As Long, f As Long, fini As Long
    Dim objXML As Object
    Dim objNode As Object
   Set OBJstream = CreateObject("ADODB.Stream")    'object utilisé ADODB stream
    OBJstream.Open: OBJstream.Type = 1    ' open with no arguments makes the stream an empty container
    OBJstream.LoadFromFile (fichier)    'on load le fichier dans l'object
    BB = OBJstream.Read()    ' on prend directement tout le paquet
 
     Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("ROOT")
    objNode.DataType = "bin.hex"
    objNode.nodeTypedValue = BB
    EncodeBase32 = objNode.Text
    Set objNode = Nothing
    Set objXML = Nothing
End Function
 
 
Function Base32tofichier(ByRef strData As String, chemin As String)    ' As Object
    Dim objXML As Object    '.DOMDocument
    Dim objNode As Object    'MSXML2.IXMLDOMElement
    Dim a() As Byte
    Dim Buffer() As Byte, intFileNumber
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("toto")
    objNode.DataType = "bin.hex"
    objNode.Text = strData
    a = objNode.nodeTypedValue
    Set objNode = Nothing
    Set objXML = Nothing
    '///////////////////////////////////
    intFileNumber = FreeFile
    Open chemin For Binary As #intFileNumber
    Put #intFileNumber, , a
    'GetBinaryData = Buffer
    Close #intFileNumber
 
End Function

Invité · 28/04/2016, 16h50

oui chez moi également, mais pourtant j'ai bien l'impression d'avoir au format texte le même valeur que coté Byte()!

Ce que je tente de retrouver ces le format initial xml.

Quand je regarde dans Catia je vois la structure xml et pas quand je l'ouvre autrement!

Édite: Je viens de penser qu'il ne faut peut-être pas recharger les balise(FfD8,FFD9) du fichier image mais le balise du Xml!

Je pense qu'il faut chercher le "FFD8" (ÿØ) avant le "JFIF"

Pour info 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F et c'est tout J,I tu oublis !

**Thmass33** · 28/04/2016, 18h47

Voici des exemples de CATPART et autres trouvés sur internet (voir fichier zip en pièce jointe).

**cerede2000** · 28/04/2016, 19h05

Oui enfin tu rencontre un cas ou tu as un soucis....
Tu ne le donnes pas, c'est pas en donnant d'autres fichiers qu'on va résoudre ton problème mais bon.
Quand tu va chez le médecin tu emmène avec toi un inconnu pour que ce soit lui qui se fasse ausculter à ta place ?

Dans ton archive j'ai vu que par exemple le fichier piston.CatPart contient 2 FFD8/FFD9 donc deux JPEG.
Je les ai extraits en fait ce sont les même donc dans ce cas peu importe du coup.

Bon sur le fichier ou tu rencontre le soucis essaye avec ceci :

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
Sub test()
    Dim intFileNum%, jpegFile%, bytTemp(0 To 3) As Byte
    intFileNum = FreeFile
    Open "C:\Temp\piston.catpart" For Binary Access Read As intFileNum
    Do While Not EOF(intFileNum)
        bytTemp(0) = bytTemp(1)
        bytTemp(1) = bytTemp(2)
        bytTemp(2) = bytTemp(3)
        Get intFileNum, , bytTemp(3)
 
        If bytTemp(0) = 255 And bytTemp(1) = 216 And bytTemp(2) = 255 And bytTemp(3) = 224 Then
            jpegFile = FreeFile
            Open "C:\Temp\piston.jpg" For Binary Access Write Lock Write As jpegFile
            Put jpegFile, , bytTemp
        ElseIf jpegFile > 0 Then
            If bytTemp(2) = 255 And bytTemp(3) = 217 Then
                Put jpegFile, , bytTemp(2) & bytTemp(3)
                Close jpegFile
                jpegFile = 0
                Exit Do
            Else
                Put jpegFile, , bytTemp(3)
            End If
        End If
    Loop
    Close intFileNum
End Sub

Je vérifie la signature complète FF D8 FF E0

**patricktoulon** · 28/04/2016, 20h24

perso j'ai aucun soucis avec ton dernier rar les 7 images sont bien récupérées et toutes font moins de 3 kilos

**cerede2000** · 28/04/2016, 20h27

Justement @Patrick, les carpart qu'il à donné ne posent en effet aucun souci avec nos codes actuels.

Mais il semble qu'il ai un fichier (Qu'il ne veut pas donner.....) qui pose souci !

Donc comme on a rien pour tester à part d'autre carpart qui fonctionnent, j'ai tenté en prennant la siganture complète JPEG FFD8FFE0 afin qu'il puisse tester ça sur son fichier à problème.

Dis moi j'ai essayer d'écrire avec ADODB.Stream mais on peut pas ecrire byte par byte

Tu as une astuce pour extraire une partie d'une array sans la reparcourir ?

Je te donne un index debut, un index fin et tu me sort un array direct ?

**patricktoulon** · 28/04/2016, 20h37

et oui c'est un peu ma grande recherche

pouvoir spliter BB POUR LE MOMENT SANS BOUCLE !! je sais pas je cherche toujours il doit bien y avoir un moyen on le découvrira
et effectivement je viens de me rendre compte que 2 images sont trop grosses il doit y avoir une autre image sans doute identique puisque a l'affichage l'image est bonne

la 4 et la 7

peut etre devrions nous en attendant un sans boucle boucler comme on le fait mais pas écrire dans le fichier juste mémoriser les bytes
ensuite que dieu vba me pardonne boucler une 2 eme fois pour spliter les deux images du code

**patricktoulon** · 28/04/2016, 20h45

que dis je dans la 4 il y en a 2 et la 7 il y en a 4

voici le rapport du debug qui donne le dernier bytes de fin et le nombre de byte total du fichier et le nombre d'image dans le catpart

352751 -- 365039
1
464158 -- 476446
1
464158 -- 476446
1
186983 -- 534575
2
339136 -- 351424
1
122469 -- 132709
1
4505 -- 318808
4

**cerede2000** · 28/04/2016, 20h53

MDR @Patrick ton PC il serais pas un peu marseillais ?????

Parce que rien dans le 7, que ce soit avec ADODB.Stream on le Open natif je ne trouve que 2 marker de fin....
Soit dit en passant 1 seul début d'ailleurs

Fin JPG
2586
Fin JPG
4505

**patricktoulon** · 28/04/2016, 23h39

mdr !!!autant pour moi c'est 4 début

t'a pas intérêt de me retraiter de marseillais se sont des doryphores

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
 
Sub test()
 Dim file As Variant, i As Long
   file = Dir(ThisWorkbook.Path & "\*.CATPart")
   While (file <> "")
      i = i + 1
          r = extract_image_catiapart2(file, i)
           file = Dir
  Wend
End Sub
Function extract_image_catiapart2(fichier, z)
    Dim OBJstream, BB() As Byte, ok As Boolean, i As Long, f As Long, fini As Long
    Set OBJstream = CreateObject("ADODB.Stream")    'object utilisé ADODB stream
    OBJstream.Open: OBJstream.Type = 1    ' open with no arguments makes the stream an empty container
    OBJstream.LoadFromFile (ThisWorkbook.Path & "\" & fichier)    'on load le fichier dans l'object
    BB = OBJstream.Read()    ' on prend directement tout le paquet
    Fin = UBound(BB) - 1
    f = UBound(BB) - 1
    '**************************************
    jpegFile = FreeFile
    Open ThisWorkbook.Path & "\image" & z & ".jpg" For Binary Access Write Lock Write As jpegFile
    l = 0
    For i = 0 To Fin
        If fini = 0 Then
            If BB(f) = 255 And BB(f + 1) = 217 Then fini = f: Debug.Print fichier & " :  " & f & " -- " & Fin
        End If
        If f > 0 Then f = f - 1
        If BB(i) = 255 And BB(i + 1) = 216 Then ok = True: l = l + 1
        If ok = True Then Put jpegFile, , BB(i)
        If i = fini And i > 0 Then Exit For
    Next
    Close jpegFile
  Debug.Print l
End Function

resultat

axe2.catpart : 352751 -- 365039
1
BearingPart.CATPart : 464158 -- 476446
1
BearingPartA.CATPart : 464158 -- 476446
1
piston.catpart : 186983 -- 534575
2
rear_light.CATPart : 339136 -- 351424
1
surf2.CATPart : 122469 -- 132709
1
surfs.CATPart : 4505 -- 318808
4

**cerede2000** · 29/04/2016, 06h44

Ah ben voilà !
Là on est d'accord

4 débuts

Mais maintenant si tu prends la signature complète à savoir FF D8 FF E0 tu n'en as plus qu'un seul

Donc c'est correcte.

@Thmass33 fais nous un retour sur le code de mon post #48 avec ton fichier qui te posais soucis.

**Thmass33** · 29/04/2016, 09h16

Ok ça marche nickel avec ton code en #48 :-) et même avec des CATDrawing et CATProduct.

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
'/*******************************************************/
'/* Programme : CATPART2JPG.xlsm                        */
'/* Objectif  : CONVERTIR DES CATPART EN JPG            */
'/* Date      : 29/04/2016                              */
'/* Version   : 1.0                                     */
'/*******************************************************/
 
Option Explicit
 
Sub CATPART2JPG()
 
'Déclaration des variables
Dim INDEX As Integer
Dim NB_FILES As Integer
Dim INTFILENUM%, JPEGFILE%, BYTTEMP(0 To 3) As Byte
Dim MSG, F_CATPART, F_JPG As String
 
'Calcul le nombre de fichier CATPART à convertir en JPG
NB_FILES = WorksheetFunction.CountA(Range("A:A"))
'Message d'erreur
If NB_FILES = 0 Then
MSG = MsgBox("Aucun fichier CATPART à convertir en JPG." & Chr(10) & "Veuillez exécuter le programme FILES, svp.", vbOKOnly + vbExclamation, "CATPART2JPG")
Exit Sub
End If
 
'COMPTEUR
For INDEX = 1 To NB_FILES
F_CATPART = Cells(INDEX, 1)
F_JPG = Cells(INDEX, 2)
    INTFILENUM = FreeFile
    Open F_CATPART For Binary Access Read As INTFILENUM
    Do While Not EOF(INTFILENUM)
        BYTTEMP(0) = BYTTEMP(1)
        BYTTEMP(1) = BYTTEMP(2)
        BYTTEMP(2) = BYTTEMP(3)
        Get INTFILENUM, , BYTTEMP(3)
 
        If BYTTEMP(0) = 255 And BYTTEMP(1) = 216 And BYTTEMP(2) = 255 And BYTTEMP(3) = 224 Then
            JPEGFILE = FreeFile
            Open F_JPG For Binary Access Write Lock Write As JPEGFILE
            Put JPEGFILE, , BYTTEMP
        ElseIf JPEGFILE > 0 Then
            If BYTTEMP(2) = 255 And BYTTEMP(3) = 217 Then
                Put JPEGFILE, , BYTTEMP(2) & BYTTEMP(3)
                Close JPEGFILE
                JPEGFILE = 0
                Exit Do
            Else
                Put JPEGFILE, , BYTTEMP(3)
            End If
        End If
    Loop
    Close INTFILENUM
Cells(INDEX, 3) = "X"
Next
 
MSG = MsgBox("Conversion terminée avec succès.", vbOKOnly + vbInformation, "CATPART2JPG")
 
End Sub
 
 
Sub FILES()
 
Application.ScreenUpdating = False
 
'Déclaration des variables
Dim MSG, FICHIER As String
Dim CHEMIN As String
Dim INDEX As Integer
 
'Définit le répertoire contenant les fichiers
CHEMIN = InputBox("Veuillez entrer le chemin d'accès" & Chr(10) & "des CATPART à convertir en JPG, svp.", "FILES")
'Message d'erreur
If CHEMIN = "" Or EXISTE(CHEMIN) = False Then
MSG = MsgBox("Erreur sur le chemin d'accès.", vbOKOnly + vbExclamation, "FILES")
Application.ScreenUpdating = True
Exit Sub
End If
 
CHEMIN = CHEMIN & "\"
FICHIER = Dir(CHEMIN & "*.*")
 
INDEX = 0
 
Do While Len(FICHIER) > 0
 INDEX = INDEX + 1
 Cells(INDEX, 1) = CHEMIN & FICHIER
 Cells(INDEX, 2) = CHEMIN & Mid(FICHIER, 1, InStrRev(FICHIER, ".") - 1) & ".JPG"
 FICHIER = Dir()
Loop
 
Cells.Select
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
 
End Sub
 
 
Function EXISTE(DOSSIER As String) As Boolean
EXISTE = Dir(DOSSIER, vbDirectory) <> ""
End Function

**patricktoulon** · 29/04/2016, 09h17

bonjour cerede
bon j'ai essayé avec la signature complète et j'ai toujours un régime a faire pour la 4 et et la 7

Code :

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

1
2
3
4
5
6
7
8
9
Sub test()
 Dim file As Variant, i As Long
   file = Dir(ThisWorkbook.Path & "\*.CATPart")
   While (file <> "")
      i = i + 1
          r = extract_image_catiapart2(file, i)
           file = Dir
  Wend
End Sub

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
Function extract_image_catiapart2(fichier, z)
    Dim OBJstream, BB() As Byte, ok As Boolean, i As Long, f As Long, fini As Long
    Set OBJstream = CreateObject("ADODB.Stream")    'object utilisé ADODB stream
    OBJstream.Open: OBJstream.Type = 1    ' open with no arguments makes the stream an empty container
    OBJstream.LoadFromFile (ThisWorkbook.Path & "\" & fichier)    'on load le fichier dans l'object
    BB = OBJstream.Read()    ' on prend directement tout le paquet
    Fin = UBound(BB) - 3
    f = UBound(BB) - 1
    '**************************************
    jpegFile = FreeFile
    Open ThisWorkbook.Path & "\image" & z & ".jpg" For Binary Access Write Lock Write As jpegFile
    l = 0
    For i = 0 To Fin
        If fini = 0 Then
            If BB(f) = 255 And BB(f + 1) = 217 Then fini = f: Debug.Print fichier & " :  " & f & " -- " & Fin
        End If
        If f > 0 Then f = f - 1
        If BB(i) = 255 And BB(i + 1) = 216 And BB(i + 2) = 255 And BB(i + 3) = 224 Then ok = True: l = l + 1
        If ok = True Then Put jpegFile, , BB(i)
        If i = fini And i > 0 Then Exit For
    Next
    Close jpegFile
  Debug.Print l
End Function

**cerede2000** · 29/04/2016, 09h18

Super !
Penses à

quand tu est satisfait

@Patrick tu as plus qu'as adapter ta version ADODB pour prendre le marker complet FF D8 FF E0

J'aurais bien voulut une version full ADODB

**patricktoulon** · 29/04/2016, 09h21

c'est fait!!!
mais on a toujours un soucis de poids pour la 4 et 7 dans mon post précédent

**patricktoulon** · 29/04/2016, 09h49

dans la rapport du debug on vois bien que ce principe ne marche pas a tout les coups dans le 4 on a encore 2 débuts

pour ce genre d'image avec cette taille elle ne devrait faire pas plus de 15000 bytes par expérience

alors soit il y a des catpart qui sont pas corrects et contiennent des erreur sans gravité qui ne provoquent pas un crash
soit il faut faire le même principe que les débuts pour les fins sinon ont a de temps en temps des image de 300kilos et un peu plus
somme toute c'est pas trop grave mais bon
Nom : demo1.gif
Affichages : 369
Taille : 671,5 Ko

Nom : demo1.gif
Affichages : 369
Taille : 671,5 Ko

Extraire l'image .JPEG encapuslée dans une pièce .CATPart (CATIA V5) [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager