Sub IGES_Decoder()
For i = 1 To 20
ActiveSheet.Columns(1).Delete
Next i
Range("A1").Select
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile("C:\Users\user1\Desktop\CATSYS\Calibrage\go.igs")
Set oTxt = oFl.OpenAsTextStream(ForReading)
oTxt.ReadAll
ligne = oTxt.Line
Dim tableau()
ReDim tableau(ligne, 162)
Set oTxt = oFl.OpenAsTextStream(ForReading)
With oTxt
While Not .AtEndOfStream
tableau(oTxt.Line, oTxt.Column - 1) = oTxt.Read(1)
Wend
End With
Dim intFic As Integer
intFic = FreeFile
Open "C:\Users\user1\Desktop\CATSYS\Calibrage\go.txt" For Output As intFic
' *************************
' *****lignes 110 !!!!*****
' *************************
i = 0
j = 0
Dim test As Boolean
test = False
While test = False
i = i + 1
If tableau(i, 73) = "P" Then test = True
Wend
test = False
While test = False
If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then
j = i
test = True
End If
i = i + 1
Wend
i = i - 1
nb110 = 0
While tableau(i, 1) <> "S"
If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 And tableau(i, 4) = "," Then
nb110 = nb110 + 1
i = i + 1
Else
i = i + 1
End If
Wend
i = i - 1
'debut = j
'fin = i
Dim doubleligne As Boolean
doubleligne = False
For cpt = j To i
If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 1 And tableau(cpt, 3) = 0 And tableau(cpt, 4) = "," Then
For co = 1 To 81
For k = 1 To 80
If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then
doubleligne = True
doublelignenum = k
Exit For
End If
Next
If doubleligne = True Then
For k = 1 To 81
tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k)
Next
End If
If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co);
If tableau(cpt, co) = ";" Then
Exit For
End If
Next
Print #intFic, ""
End If
Next
nbline = nbline + i - j + 1
' *************************
' *****matrix 124 !!!!*****
' *************************
i = 0
j = 0
test = False
While test = False
i = i + 1
If tableau(i, 73) = "P" Then test = True
Wend
test = False
While test = False
If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then
j = i
test = True
End If
i = i + 1
Wend
i = i - 1
nb124 = 0
While tableau(i, 1) <> "S"
If tableau(i, 1) = 1 And tableau(i, 2) = 2 And tableau(i, 3) = 4 And tableau(i, 4) = "," Then
nb124 = nb124 + 1
i = i + 1
Else
i = i + 1
End If
Wend
i = i - 1
'debut = j
'fin = i
doubleligne = False
For cpt = j To i
If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 2 And tableau(cpt, 3) = 4 And tableau(cpt, 4) = "," Then
For co = 1 To 162
For k = 1 To 80
If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then
doubleligne = True
doublelignenum = k
Exit For
End If
Next
If doubleligne = True Then
For k = 1 To 81
tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k)
Next
End If
If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co);
If tableau(cpt, co) = ";" Then
Exit For
End If
Next
Print #intFic, ""
End If
Next
nbline = nbline + i - j + 1
' *************************
' *****circle 100 !!!!*****
' *************************
i = 0
j = 0
test = False
While test = False
i = i + 1
If tableau(i, 73) = "P" Then test = True
Wend
test = False
While test = False
If tableau(i, 1) = 1 And tableau(i, 2) = 1 And tableau(i, 3) = 0 Then
j = i
test = True
End If
i = i + 1
Wend
i = i - 1
nb100 = 0
While tableau(i, 1) <> "S"
If tableau(i, 1) = 1 And tableau(i, 2) = 0 And tableau(i, 3) = 0 And tableau(i, 4) = "," Then
nb100 = nb100 + 1
i = i + 1
Else
i = i + 1
End If
Wend
i = i - 1
'debut = j
'fin = i
doubleligne = False
For cpt = j To i
If tableau(cpt, 1) = 1 And tableau(cpt, 2) = 0 And tableau(cpt, 3) = 0 And tableau(cpt, 4) = "," Then
For co = 1 To 81
For k = 1 To 80
If tableau(cpt, k) = "," And tableau(cpt, k + 1) = " " Then
doubleligne = True
doublelignenum = k
Exit For
End If
Next
If doubleligne = True Then
For k = 1 To 81
tableau(cpt, doublelignenum + k) = tableau(cpt + 1, k)
Next
End If
If tableau(cpt, co) <> ";" Then Print #intFic, tableau(cpt, co);
If tableau(cpt, co) = ";" Then
Exit For
End If
Next
Print #intFic, ""
End If
Next
nbline = nbline + i - j + 1
'COPIE !!
Close intFic
Range("A1").Value = "type"
Range("B1").Value = "x1"
Range("C1").Value = "y1"
Range("D1").Value = "z1"
Range("E1").Value = "x2"
Range("F1").Value = "y2"
Range("G1").Value = "z2"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\User1\Desktop\CATSYS\Calibrage\go.txt", Destination:=Range("$A$2"))
.Name = "Part1_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=12
Range("A1").Select
Range("H2", "O" & nb110 + 1).Value = ""
'ActiveSheet.Columns(8).Delete
'ActiveSheet.Columns(8).Delete
'ActiveSheet.Columns(8).Delete
intFic = FreeFile
Open "C:\Users\user1\Desktop\CATSYS\Calibrage\go.mac" For Output As intFic
Print #intFic, "FINISH"
Print #intFic, "/CLEAR,NOSTART"
Print #intFic, "/prep7"
Print #intFic, "et,1,beam188"
'Print #intFic, "KEYOPT , 1, 1, 1"
'Print #intFic, "KEYOPT , 1, 2, 0"
Print #intFic, "et,2,combin14"
Print #intFic, "KEYOPT , 2, 1, 0"
Print #intFic, "KEYOPT , 2, 2, 6"
'Print #intFic, "KEYOPT , 2, 3, 4"
Print #intFic, "type,1"
Print #intFic, "MP,DENS,1,8.96e-09, ! tonne mm^-3"
Print #intFic, "MP,EX,1,107000, ! tonne s^-2 mm^-1"
Print #intFic, "MP,NUXY,1,0.22,"
Print #intFic, "MP,MURX,1,10000,"
j = 0
Print #intFic, "SECTYPE , 1, BEAM, RECT, , 0"
Print #intFic, "SECOFFSET , CENT"
Print #intFic, "SECDATA , 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0"
Print #intFic, "SECNUM , 1"
For i = 1 To nb110
Print #intFic, "n,," & Range("B" & i + 1).Value & "," & Range("C" & i + 1).Value & "," & Range("D" & i + 1).Value & ","
Print #intFic, "n,," & Range("E" & i + 1).Value & "," & Range("F" & i + 1).Value & "," & Range("G" & i + 1).Value & ","
j = j + 2
Print #intFic, "e," & j - 1 & "," & j
Next
Dim xnoeud() As String
Dim ynoeud() As String
Dim raid() As String
ReDim xnoeud(nb124)
ReDim ynoeud(nb124)
ReDim raid(nb124)
Print #intFic, "*dim,listnoeuds,," & nb124 & "," & 2
Print #intFic, "n , , 0, 0, 1"
For i = 1 To nb124
xnoeud(i) = Range("E" & nb110 + i + 1).Value
ynoeud(i) = Range("I" & nb110 + i + 1).Value
raid(i) = Range("E" & i + nb124 + nb110 + 1).Value
Next
Print #intFic, "type,2"
For i = 1 To nb124
Print #intFic, "nsel , all"
Print #intFic, "noeud1=NODE(" & xnoeud(i) & "," & ynoeud(i) & ",0)"
Print #intFic, "nsel,u,node,,noeud1"
Print #intFic, "noeud2=NODE(" & xnoeud(i) & "," & ynoeud(i) & ",0)"
Print #intFic, "nsel,all"
Print #intFic, "R," & i & "," & raid(i) & "*2000,0,0,0,0,0,0,"
Print #intFic, "RMORE,0,"
Print #intFic, "REAL," & i
Print #intFic, "e,noeud1,noeud2," & nb110 + 1
Print #intFic, "cerig,noeud1,noeud2,UXYZ"
Print #intFic, "listnoeuds(" & i & ",1)=noeud1"
Print #intFic, "listnoeuds(" & i & ",2)=noeud2"
Next
Print #intFic, "nsel , all"
For i = 1 To nb124
Print #intFic, "nsel , u, Node, , listnoeuds(" & i & ", 1)"
Print #intFic, "nsel , u, Node, , listnoeuds(" & i & ", 2)"
Next
Print #intFic, "numm,node,.01"
Print #intFic, "nsel,all"
Print #intFic, "esel,all"
Print #intFic, " *ask, Noeudchar, ""Charger quel noeud ?"", 1 "
Print #intFic, " *ask, forceY, ""Quelle force en Y ?"", 0 "
Print #intFic, " *ask, forceX, ""Quelle force en X ?"", 0 "
Print #intFic, " *ask, NbNoeudblo, ""Bloquer Combien de noeud(s) ?"", 1 "
Print #intFic, "*dim,Noeudblo,, NbNoeudblo"
Print #intFic, "*do,i,1,NbNoeudblo"
Print #intFic, " *ask, Noeudblo(i), ""Bloquer quel noeud ?"", 1 "
Print #intFic, "D,Noeudblo(i),all,0"
Print #intFic, "*enddo"
Print #intFic, "F,Noeudchar,FY,forceY"
Print #intFic, "F,Noeudchar,FX,forceX"
'Print #intFic, "F,48,FY,100"
'Print #intFic, "F,48,FX,10"
'Print #intFic, "D,14,all,0"
'Print #intFic, "D,30,all,0"
'Print #intFic, "D,58,all,0"
Print #intFic, "/eof"
Print #intFic, "/sol"
Print #intFic, "solve"
Print #intFic, "/POST1"
Print #intFic, "INRES , ALL"
Print #intFic, "FILE,'Calibrage','rst','.'"
Print #intFic, "SET,LAST"
Print #intFic, "SET,FIRST"
Print #intFic, "/PLOPTS,INFO,3"
Print #intFic, "/CONTOUR,ALL,18"
Print #intFic, "/PNUM,MAT,1"
Print #intFic, "/NUMBER,1"
Print #intFic, "/REPLOT,RESIZE"
Print #intFic, "PLDISP , 1"
Print #intFic, "ANDSCL , 30, 0.01"
Print #intFic, "/SHOW,WIN32"
Print #intFic, "/REPLOT,RESIZE"
Close intFic
End Sub