VB调用ETABS API失败：无法获取工况与组合数据至Excel列表框

问题诊断 #

• 变量未显式声明且类型不匹配：代码中NumberNames、MyName、ret、i均未声明，MyName作为接收工况/组合名称的数组，需显式定义为字符串数组；
• ETABS对象有效性检查滞后：当前代码在尝试调用API获取数据后才检查EtabsObject是否为空，若对象获取失败，后续API调用会直接报错；
• 未校验API调用返回值：ETABS API的返回值ret为0时表示调用成功，非0则为错误码，未判断返回值无法定位API调用失败原因；
• 重复复用变量导致数据覆盖：获取荷载组合时复用了NumberNames和MyName变量，可能导致工况数据被覆盖，且未重新初始化数组；
• 缺失楼层名称获取逻辑：需求中需导入楼层名称至listBox3，但代码未实现该部分。

修正后的完整代码 #

Option Explicit ' 强制变量声明，避免隐式变体错误

Public Sub ETABS_MODEL_vishwa()
    Dim myHelper As cHelper
    Dim EtabsObject As Object
    Dim SapModel As Object
    Dim ret As Long
    Dim NumberCases As Integer, NumberCombos As Integer, NumberStories As Integer
    Dim LoadCaseNames() As String, ComboNames() As String, StoryNames() As String
    Dim i As Integer
    
    ' 创建ETABS对象并检查有效性
    Set myHelper = New Helper
    Set EtabsObject = myHelper.GetObject("CSI.ETABS.API.ETABSObject")
    
    If EtabsObject Is Nothing Then
        MsgBox "无法获取ETABS实例，请确保ETABS已启动运行。", vbExclamation
        Exit Sub
    End If
    
    ' 获取SapModel对象
    Set SapModel = EtabsObject.SapModel
    
    ' 设置单位为kN-m-℃
    ret = SapModel.SetPresentUnits(eUnits_kN_m_C)
    If ret <> 0 Then
        MsgBox "单位设置失败，错误码：" & ret, vbCritical
        Exit Sub
    End If
    
    ' 导入荷载工况至ListBox1
    Sheets(1).ListBox1.Clear
    ret = SapModel.LoadCases.GetNameList(NumberCases, LoadCaseNames)
    If ret = 0 Then
        For i = 0 To NumberCases - 1
            Sheets(1).ListBox1.AddItem LoadCaseNames(i)
            Debug.Print "荷载工况：" & LoadCaseNames(i)
        Next i
    Else
        MsgBox "获取荷载工况失败，错误码：" & ret, vbCritical
    End If
    
    ' 导入荷载组合至ListBox2
    Sheets(1).ListBox2.Clear
    ret = SapModel.RespCombo.GetNameList(NumberCombos, ComboNames)
    If ret = 0 Then
        For i = 0 To NumberCombos - 1
            Sheets(1).ListBox2.AddItem ComboNames(i)
            Debug.Print "荷载组合：" & ComboNames(i)
        Next i
    Else
        MsgBox "获取荷载组合失败，错误码：" & ret, vbCritical
    End If
    
    ' 导入楼层名称至ListBox3
    Sheets(1).ListBox3.Clear
    ret = SapModel.Story.GetNameList(NumberStories, StoryNames)
    If ret = 0 Then
        For i = 0 To NumberStories - 1
            Sheets(1).ListBox3.AddItem StoryNames(i)
            Debug.Print "楼层名称：" & StoryNames(i)
        Next i
    Else
        MsgBox "获取楼层名称失败，错误码：" & ret, vbCritical
    End If
    
    Debug.Print "ETABS对象类型：" & TypeName(EtabsObject)
    Debug.Print "荷载工况数量：" & NumberCases
    Debug.Print "荷载组合数量：" & NumberCombos
    Debug.Print "楼层数量：" & NumberStories
End Sub

"Get reactions"按钮点击事件实现 #

在Sheet1的代码模块中添加以下事件，用于获取选中工况/组合的反力：

Private Sub CommandButton1_Click() ' 假设按钮名称为CommandButton1
    Dim selectedCase As String
    Dim SapModel As Object
    Dim ret As Long
    Dim React() As Double, NodeName() As String, NumberNodes As Integer
    Dim i As Integer
    
    ' 确保ETABS对象已连接
    If EtabsObject Is Nothing Then
        MsgBox "ETABS实例未连接，请先运行ETABS_MODEL_vishwa子程序。", vbExclamation
        Exit Sub
    End If
    Set SapModel = EtabsObject.SapModel
    
    ' 获取选中的工况/组合（优先组合，再工况）
    If Sheets(1).ListBox2.ListIndex <> -1 Then
        selectedCase = Sheets(1).ListBox2.Value
    ElseIf Sheets(1).ListBox1.ListIndex <> -1 Then
        selectedCase = Sheets(1).ListBox1.Value
    Else
        MsgBox "请先选择一个荷载工况或组合。", vbExclamation
        Exit Sub
    End If
    
    ' 获取所有节点反力（可根据需求筛选特定节点）
    ret = SapModel.Results.Setup.DeselectAllCasesAndCombosForOutput
    ret = SapModel.Results.Setup.SelectCaseOrComboForOutput(selectedCase)
    ret = SapModel.Results.NodalDispl("", eResultCase, selectedCase, NumberNodes, NodeName, , , , React)
    
    If ret = 0 And NumberNodes > 0 Then
        ' 将反力输出至Sheet2（可自定义输出位置）
        Sheets(2).Range("A1:C1").Value = Array("节点名称", "X方向反力(kN)", "Y方向反力(kN)")
        For i = 0 To NumberNodes - 1
            Sheets(2).Range("A" & i + 2).Value = NodeName(i)
            Sheets(2).Range("B" & i + 2).Value = React(i * 6) ' X方向反力（索引对应ETABS API的反力顺序）
            Sheets(2).Range("C" & i + 2).Value = React(i * 6 + 1) ' Y方向反力
        Next i
        MsgBox "反力已导出至Sheet2。", vbInformation
    Else
        MsgBox "获取反力失败，错误码：" & ret, vbCritical
    End If
End Sub

关键说明 #

• 确保已引用ETABS的API类型库（在VBA编辑器中依次点击工具→引用，勾选CSI ETABS API 20xx Type Library）；
• eUnits_kN_m_C、eResultCase等枚举值需在引用ETABS类型库后才能正常使用；
• 反力数组的索引顺序需参照ETABS API文档，示例中仅展示X/Y方向反力，可根据需求扩展Z方向反力、弯矩等。

内容的提问来源于stack exchange，提问作者munmun swami