Export results ARSA via API
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
A copy of a popular discussion thread from 2012.
msg 20
Sub extraction_resultats_cas()
Range("A13", "F25000").Clear
Range("B5").Clear
Set RobApp = New RobotApplication
If Not RobApp.Visible Then
Set RobApp = Nothing
MsgBox "Open Robot and load Model", vbOKOnly, "ERROR"
Exit Sub
Else
If (RobApp.Project.Type <> I_PT_FRAME_3D) And (RobApp.Project.Type <> I_PT_SHELL) Then
MsgBox "Structure Type should be FRAME 3D or SHELL", vbOKOnly, "ERROR"
Exit Sub
End If
Cells(5, 1) = "Project"
Cells(5, 2) = RobApp.Project.Name
'selection des barres
'If CheckBox1 = True Then
'Dim BarCol As RobotBarCollection
'Set BarCol = RobApp.Project.Structure.Bars.GetAll
'Else
Dim RSelection As RobotSelection
Set RSelection = RobApp.Project.Structure.Selections.Get(I_OT_BAR)
Dim BarCol As RobotBarCollection
Set BarCol = RobApp.Project.Structure.Bars.GetMany(RSelection)
Dim num_bar As String
' If (BarCol.Count = 0) Then c'est un test de selection du modele
' If (MsgBox("No bars selected in Robot. Do you want to import results for all bars?", vbYesNo, "Warning") = vbYes) Then
num_bar = Cells(8, 2)
If num_bar = "" Then
If (MsgBox("Pas de numéro de barres indiqué ! Voulez-vous selectionner toutes les barres?", vbYesNo, "Warning") = vbYes) Then
RSelection.FromText "all"
RSelection.AddText "tous"
Set BarCol = RobApp.Project.Structure.Bars.GetMany(RSelection)
Else
Set BarCol = Nothing
Exit Sub
End If
' ajout condition pour rentrer soi-même les numéros de barres
Else
RSelection.FromText num_bar
Set BarCol = RobApp.Project.Structure.Bars.GetMany(RSelection)
End If
'End If
Set RSelection = RobApp.Project.Structure.Selections.Get(I_OT_CASE)
Dim CaseCol As RobotCaseCollection
Set CaseCol = RobApp.Project.Structure.Cases.GetMany(RSelection)
Dim num_cas As String
num_cas = Cells(9, 2)
' If (CaseCol.Count = 0) Then
If num_cas = "" Then
If (MsgBox("Pas de cas ou combinaisons indiqué ! Voulez-vous importer les résultats de tous les cas ?", vbYesNo, "Warning") = vbYes) Then
RSelection.FromText "all"
RSelection.AddText "tous"
Set CaseCol = RobApp.Project.Structure.Cases.GetMany(RSelection)
Else
Set CaseCol = Nothing
Exit Sub
End If
Else
RSelection.FromText num_cas
Set CaseCol = RobApp.Project.Structure.Cases.GetMany(RSelection)
End If
Cells(9, 2) = RSelection.ToText
NumberOfPoints = Int(Cells(10, 2).Value)
If (NumberOfPoints < 2) Then
MsgBox "Number of points along the bar must be greater or equal to 2", vbOKOnly, "Error"
Exit Sub
End If
'Sleep 10000
Row = 12
' Cells(Row, 1) = "Barre"
' Cells(Row, 2) = "Noeud"
' Cells(Row, 3) = "Cas (/ Composante)"
'
' Cells(Row, 4) = "FX [kN]"
' Cells(Row, 5) = "FZ [kN]"
' Cells(Row, 6) = "MY [kN.m]"
Cells(19, 9) = "Progression"
For i = 1 To BarCol.Count
Cells(20, 9) = Str(i) + " / " + Str(BarCol.Count)
Dim RBar As RobotBar
Set RBar = BarCol.Get(i)
BarNumber = RBar.Number
BarStr = Str(BarNumber)
OriNodeStr = Str(RBar.StartNode)
EndNodeStr = Str(RBar.EndNode)
Dim BFD As RobotBarForceData
Dim Icomp As Integer
Dim BarForceServer As RobotBarForceServer
Set BarForceServer = RobApp.Project.Structure.Results.Bars.Forces
Dim Point As Double
Dim Step As Double
Point = 0#
Step = 1# / (NumberOfPoints - 1)
For ii = 1 To NumberOfPoints
For j = 1 To CaseCol.Count
AT = CaseCol.Get(j).AnalizeType
If AT <> I_CAT_COMB_CODE _
And AT <> I_CAT_COMB _
And AT <> I_CAT_COMB_NONLINEAR _
And AT <> I_CAT_STATIC_LINEAR _
And AT <> I_CAT_STATIC_NONLINEAR Then
MsgBox "This macro works only for simple load cases, combinations and automatic combinations", vbOKOnly, "Error"
Exit Sub
End If
UNC = CaseCol.Get(j).Number
CaseStr = Str(UNC)
If CaseCol.Get(j).Type = I_CT_CODE_COMBINATION Then ' pour les combinaisons
Dim CCount As Integer
CCount = CaseCol.Get(j).Components.Count
Dim StrCC As String
StrCC = Str(CCount)
If InStr(CaseCol.Get(j).Name, "+") <> 4 And InStr(CaseCol.Get(j).Name, "-") <> 4 And InStr(CaseCol.Get(j).Name, "+") <> 8 And InStr(CaseCol.Get(j).Name, "-") <> 8 Then
For Icomp = 1 To CCount
CompStr = " / " + Str(Icomp)
Row = Row + 1
If ii = 1 Then
Cells(Row, 1) = BarStr
Cells(Row, 2) = OriNodeStr
Cells(Row, 3) = CaseStr + CompStr
ElseIf ii = NumberOfPoints Then
Cells(Row, 1) = BarStr
Cells(Row, 2) = EndNodeStr
Cells(Row, 3) = CaseStr + CompStr
Else
Cells(Row, 1) = BarStr + Str(ii) + " /" + Str(NumberOfPoints) + " / " + CaseStr + CompStr
End If
Set BFD = BarForceServer.ValueEx(BarNumber, UNC, Icomp, Point)
Cells(Row, 4) = BFD.FX * 0.001
Cells(Row, 5) = BFD.FZ * 0.001
Cells(Row, 6) = BFD.MY * 0.001
Set BFD = Nothing
Next Icomp
End If
Else ' pour les cas simples
Row = Row + 1
If ii = 1 Then
Cells(Row, 1) = BarStr
Cells(Row, 2) = OriNodeStr
Cells(Row, 3) = CaseStr
ElseIf ii = NumberOfPoints Then
Cells(Row, 1) = BarStr
Cells(Row, 2) = EndNodeStr
Cells(Row, 3) = CaseStr
Else
Cells(Row, 1) = BarStr
Cells(Row, 2) = Str(ii) + " /" + Str(NumberOfPoints)
Cells(Row, 3) = CaseStr
End If
Set BFD = BarForceServer.Value(BarNumber, UNC, Point)
Cells(Row, 4) = BFD.FX * 0.001
Cells(Row, 5) = BFD.FZ * 0.001
Cells(Row, 6) = BFD.MY * 0.001
Set BFD = Nothing
End If
Point = Point + Step
Next j
Next ii
Next i
End If
Cells(19, 9) = ""
Cells(20, 9) = ""
End Sub
