Sub Get_Selected_Beams()
Dim objOpenSTAAD As Object
On Error Resume Next
Set objOpenSTAAD = GetObject(, "StaadPro.OpenSTAAD")
If objOpenSTAAD Is Nothing Then
MsgBox "STAAD.Pro is not running or OpenSTAAD is unavailable.", vbCritical
Exit Sub
End If
On Error GoTo 0
' Improve performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Create or clear the "SELBEAMS" sheet
Dim ws As Worksheet
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets("SELBEAMS")
On Error GoTo 0
If ws Is Nothing Then
Set ws = Worksheets.Add(After:=ActiveSheet)
ws.Name = "SELBEAMS"
Else
' Clear all contents
ws.Cells.Clear
' Remove any row grouping
ws.Rows.Ungroup
' Remove any column grouping
ws.Columns.Ungroup
' Reset outline levels
ws.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
End If
' Get selected beam data
Dim selectedBeams() As Long
Dim beamCount As Long
beamCount = objOpenSTAAD.Geometry.GetNoOfSelectedBeams()
If beamCount = 0 Then
MsgBox "No beams are selected in STAAD model.", vbExclamation
GoTo Cleanup
End If
ReDim selectedBeams(beamCount - 1)
objOpenSTAAD.Geometry.GetSelectedBeams selectedBeams
' Write headers
Dim headers As Variant
headers = Array("Beam ID", "Start Node", "End Node", "Property Ref.", "Material", "Beta
Angle", "Length", _
"Beam Section Display Name", "Beam Section Name",
"BeamSectionPropertyTypeNo", "Section Type", _
"MemberUniqueID", "IsColumn?", "IsBeam?", "Country Code", "E", "F", "G", "H",
"I")
ws.Range("A4:T4").Value = headers
' Loop through selected beams
Dim i As Long, beamNo As Long
Dim startNode As Long, endNode As Long
Dim propRef As Long, betaAngle As Double
Dim materialName As String, BeamSectionDisplayName As String,
BeamSectionName As String
Dim BeamSectionPropertyTypeNo As Long, MemberUniqueID As String
Dim IsColumn As Boolean, IsBeam As Boolean, CountryCode As Long
Dim Length As Double
For i = 1 To beamCount
beamNo = selectedBeams(i - 1)
objOpenSTAAD.Geometry.GetMemberIncidence beamNo, startNode, endNode
ws.Cells(i + 4, 1).Value = beamNo
ws.Cells(i + 4, 2).Value = startNode
ws.Cells(i + 4, 3).Value = endNode
propRef = objOpenSTAAD.Property.GetBeamSectionPropertyrefNo(beamNo)
ws.Cells(i + 4, 4).Value = propRef
materialName = objOpenSTAAD.Property.GetBeamMaterialName(beamNo)
ws.Cells(i + 4, 5).Value = materialName
betaAngle = objOpenSTAAD.Property.GetBetaAngle(beamNo)
ws.Cells(i + 4, 6).Value = Round(betaAngle, 3)
Length = objOpenSTAAD.Geometry.GetBeamLength(beamNo)
ws.Cells(i + 4, 7).Value = Round(Length, 3)
BeamSectionDisplayName =
objOpenSTAAD.Property.GetBeamSectionDisplayName(beamNo)
BeamSectionName = objOpenSTAAD.Property.GetBeamSectionName(beamNo)
ws.Cells(i + 4, 8).Value = BeamSectionDisplayName
ws.Cells(i + 4, 9).Value = BeamSectionName
BeamSectionPropertyTypeNo =
objOpenSTAAD.Property.GetBeamSectionPropertyTypeNo(beamNo)
ws.Cells(i + 4, 10).Value = BeamSectionPropertyTypeNo
MemberUniqueID = objOpenSTAAD.Geometry.GetMemberUniqueID(beamNo)
ws.Cells(i + 4, 12).Value = MemberUniqueID
IsColumn = objOpenSTAAD.Geometry.IsColumn(beamNo, 5)
IsBeam = objOpenSTAAD.Geometry.IsBeam(beamNo, 5)
ws.Cells(i + 4, 13).Value = IsColumn
ws.Cells(i + 4, 14).Value = IsBeam
CountryCode = objOpenSTAAD.Property.GetCountryTableNo(beamNo)
ws.Cells(i + 4, 15).Value = CountryCode
Next i
' Apply XLOOKUP for Section Type
Dim formulaRange As Range
Set formulaRange = ws.Range("K5:K" & beamCount + 4)
formulaRange.FormulaR1C1 = "=XLOOKUP(RC[-
1],'STAAD_SECTION_TYPE_TABLE'!R2C3:R48C3,'STAAD_SECTION_TYPE_TABLE'!R2C2:R
48C2,""NA"",0)"
' Hide the lookup sheet
On Error Resume Next
Worksheets("STAAD_SECTION_TYPE_TABLE").Visible = xlSheetHidden
On Error GoTo 0
' Optional: Create a space-separated list of Beam IDs in B1
ws.Range("B1").Formula = "=TEXTJOIN("" "", TRUE, A5:A" & beamCount + 4 & ")"
' Apply filter dynamically
ws.Range("A4:T" & beamCount + 4).AutoFilter
' Autofit columns
ws.Columns("C:T").AutoFit
' Optional: Group columns and format
ws.Columns("L:O").Group
ws.Columns("J").Group
ws.Rows("1:1").Group
' Message box
MsgBox "Selected Beams: " & beamCount & vbCrLf & _
"Total Nodes: " & objOpenSTAAD.Geometry.GetNodeCount(), vbInformation
Cleanup:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set objOpenSTAAD = Nothing
End Sub
