Sub Optimization()
    
'   Interface zu RFEM wird geholt
Dim iApp As RFEM5.Application
Set iApp = GetObject(, "RFEM5.Application")

'   Fehlerbehandlungsroutine
On Error GoTo e

'   COM-Lizenz und Programmzugriff wird gesperrt
iApp.LockLicense

'   Interface fr erstes Modell holen
Dim iModel As RFEM5.model
If iApp.GetModelCount > 0 Then
    Set iModel = iApp.GetModel(0)
Else
    Err.Raise vbObjectError, "LoadModel()", "iApp.GetModelCount < 1"
End If

'   Interface fr Modelldaten holen
Dim iModelData As RFEM5.iModelData
Set iModelData = iModel.GetModelData()

'   Querschnittsnummer von gewnschtem Querschnitt holen
Dim crsc_desc As String
crsc_desc = "IPE 300"

Dim crscs() As RFEM5.CrossSection
crscs = iModelData.GetCrossSections
Dim crsc_no As Long
crsc_no = -1
Dim i As Long
For i = 0 To UBound(crscs, 1)
    If InStr(LCase(crscs(i).Description), LCase(crsc_desc)) > 0 Then
        crsc_no = crscs(i).No
        Exit For
    End If
Next i

If crsc_no = -1 Then
    Err.Raise 513, "Get cross-section number", "No cross-section with "" " & crsc_desc & " "" within its description found!"
End If

'   Stbe mit dem betreffendem Querschnitt finden
Dim mems_str As String
mems_str = vbanullstr

Dim mems() As RFEM5.Member
mems = iModelData.GetMembers
For i = 0 To UBound(mems, 1)
    If mems(i).EndCrossSectionNo = crsc_no Then
        If mems(i).EndCrossSectionNo = mems(i).StartCrossSectionNo Then
            mems_str = mems_str & mems(i).No & ","
        End If
    End If
Next i

If mems_str = vbanullstr Then
    Err.Raise 514, "Get members", "No member with cross-section "" " & crsc_desc & " "" found!"
End If

'   Interface fr Modul holen
Dim iStec3 As STEEL_EC3.Module
Set iStec3 = iModel.GetModule("STEEL_EC3")


'   vorhandene Modulflle lschen
Dim count As Long
count = iStec3.moGetCaseCount
If count > 0 Then
    For i = 0 To count - 1
      iStec3.moDeleteCase i, AT_INDEX
    Next i
End If


'   Modulfall "Optimization" anlegen
Dim iStec3Case As STEEL_EC3.ICase
Set iStec3Case = iStec3.moSetCase(1, "Optimization")

'   Stbe fr Bemessung setzen
iStec3Case.moSetMemberList mems_str

'   Lastkombinationen setzen
Dim iStec3_uls_loads(0 To 2) As STEEL_EC3.ULS_LOAD

iStec3_uls_loads(0).DesignSituation = DS_FUNDAMENTAL
iStec3_uls_loads(0).No = 1
iStec3_uls_loads(0).Type = ILOAD_GROUP

iStec3_uls_loads(1).DesignSituation = DS_FUNDAMENTAL
iStec3_uls_loads(1).No = 2
iStec3_uls_loads(1).Type = ILOAD_GROUP

iStec3_uls_loads(2).DesignSituation = DS_FUNDAMENTAL
iStec3_uls_loads(2).No = 3
iStec3_uls_loads(2).Type = ILOAD_GROUP

iStec3Case.moSetULSLoads iStec3_uls_loads


e: If Err.Number <> 0 Then MsgBox Err.Description, , Err.Source

'   COM-Lizenz wird freigegeben, Programmzugriff wieder mglich
iModel.GetApplication.UnlockLicense

End Sub