OS. Envelopes Table Macro
The purpose of this macro is to create a results table in STAAD.Pro containing an envelope of results.
The macro contains the following routines:
- Main. This is the primary routine from which the macro is launched and checks that STAAD.Pro is running and the model loaded has available results which are needed for this example. However if the table you wish to construct does not require the model to have been analysed, then clearly that part of the routine can be removed.
- STAADTable. Once the validation is done, this routine is called to produce the table in STAAD.Pro. As this table will require a selection of load cases, it includes a call to a routine to select load cases called SelectLoadCases, then the routine to create the empty table called CreateTable and finally to fill the table with data called FillTable.
- ResetEnvTable. A simple routine to make sure the table is cleared and a label added in column 1 of each row for this example to mirror the labels used in the general Envelope sheet of the Node displacement table.
- SelectLoadCases. This is routine that displays a user dialog to select the load cases and combinations from which the node displacements will be used to form the final table. This makes use of a couple of other routines AddLoadCaseToSelected, and ExcludeLoadCaseFromSelected to maintain two lists of load cases, those that are available from STAAD.Pro and those that will be used to create the table.
- AddLoadCaseToSelected. When [>] is clicked, this routine adds the selected load cases.
- ExcludeLoadCaseFromSelected. When Exclude is clicked, the load case in the selected Load Case list is removed from the list.
- CreateEnvList. A simple routine that creates a list of the load case numbers from the text of the dialog box Selected Load Cases.
- FillTable. Populates the table with the calculated data which has been put into a two-dimensional array (i.e., row, column)
- CreateTable. The routine that forms the table framework and sets the headings. Note that it also checks to see the unit system so that the headers can include the appropriate units. Also note that there are commented out lines that indicate how additional sheets can be added to the Report that could be used for other data such as End Forces or Reactions.
Macro Code
To use this macro, copy and the paste the code into a .vbs file (e.g., Table Envelope.vbs). Then import this macro into STAAD.Pro to use it.
'#Reference {EDA9FA7F-EFC9-4264-9513-39CF6E72604D}#1.0#0# C:\Program Files\Bentley\Engineering\STAAD.Pro 2023\ \STAAD\StaadPro.dll#OpenSTAADUI#OpenSTAADUI
'Simple Macro using OpenSTAAD to create a table of envelopes.
'v1.0 (22 Dec 2015) CA
'v1.1 (23 Dec 2015) CA - Minor index issue fixes
'v1.2 (08 May 2020) JTC - Update with CE
Option Explicit
Public staadObj As Object
Public Geometry As OSGeometryUI
Public Loads As OSLoadUI
Public Output As OSOutputUI
Public Tables As OSTableUI
Sub Main()
Dim stdFile As String
Dim nResult As Boolean
Set staadObj = GetObject(,"StaadPro.OpenSTAAD")
Set Geometry = staadObj.Geometry
Set Loads = staadObj.Load
Set Output = staadObj.Output
Set Tables = staadObj.Table
'Make sure STAAD is loaded and running
staadObj.GetSTAADFile(stdFile,True)
If stdFile <> "" Then 'no file loaded
'Check there are results
nResult = Output.AreResultsAvailable
If nResult = True Then 'Results are available
STAADTable staadObj
Else
MsgBox "This macro requires the current model to have results.", vbOkOnly
End If
Else
MsgBox "This macro can only be run with a valid STAAD file loaded.", vbOkOnly
End If
Set staadObj = Nothing
End Sub
Sub STAADTable(staadObj As Object)
Dim nReturn As Integer
Dim i As Integer, j As Integer, k As Integer
'Dim Geometry As OSGeometryUI
'Set Geometry = staadObj.Geometry
Dim nTableRows As Integer, nCols As Integer
nTableRows=13
nCols = 10
Dim tblNodes As Long, rptno As Long
Dim lPrimaryLoadCaseCount As Long
Dim lPrimaryLoadCaseNumbersArray() As Long
Dim lGetLoadCombinationCaseCount As Long
Dim lLoadCombinationCaseNumbersArray() As Long
Dim EnvList() As Long
Dim LoadListCount As Integer
SelectLoadCases staadObj, EnvList(), LoadListCount
'MsgBox Str$(LoadListCount)
Dim EnvRowVal(13) As Double
Dim EnvRow(13,10) As String
Dim LoadCase As Long
Dim ColVal As Integer
'Node Displacement Envelope
Dim nNodes As Long
Dim nNode() As Long
nNodes = Geometry.GetNodeCount()
ReDim nNode(nNodes)
Geometry.GetNodeList(nNode)
Dim dDisplacementArray(6) As Double
Dim nResultant As Double
ResetEnvTable EnvRow, nTableRows, nCols
For i = 1 To LoadListCount
LoadCase = EnvList(i)
For j = 0 To nNodes-1
nReturn = Output.GetNodeDisplacements( nNode(j), LoadCase, dDisplacementArray)
nResultant = (dDisplacementArray(0)^2+dDisplacementArray(1)^2+dDisplacementArray(2)^2)^0.5
For k = 1 To 6
'max values
If dDisplacementArray(k-1) > EnvRowVal(2*k-1) Then
EnvRowVal(2*k-1) = dDisplacementArray(k-1)
EnvRow(2*k-1, 2)= Str$(nNode(j))
EnvRow(2*k-1, 3)= Str$(LoadCase)
For ColVal = 1 To 3
EnvRow(2*k-1, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
Next ColVal
EnvRow(2*k-1, ColVal+3) = Format$(nResultant,"#.000")
For ColVal = 1 To 3
EnvRow(2*k-1, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
Next ColVal
End If
'min values
If dDisplacementArray(k-1) < EnvRowVal(2*k) Then
EnvRowVal(2*k) = dDisplacementArray(k-1)
EnvRow(2*k, 2)= Str$(nNode(j))
EnvRow(2*k, 3)= Str$(LoadCase)
For ColVal = 1 To 3
EnvRow(2*k, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
Next ColVal
EnvRow(2*k, ColVal+3) = Format$(nResultant,"#.000")
For ColVal = 1 To 3
EnvRow(2*k, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
Next ColVal
End If
'resultant
If nResultant > EnvRowVal(13) Then
EnvRowVal(13) = nResultant
EnvRow(13, 2)= Str$(nNode(j))
EnvRow(13, 3)= Str$(LoadCase)
For ColVal = 1 To 3
EnvRow(13, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
Next ColVal
EnvRow(13, ColVal+3) = Format$(nResultant,"#.000")
For ColVal = 1 To 3
EnvRow(13, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
Next ColVal
End If
Next k
Next j
Next i
'Create the Table
'CreateTable staad,nTableRows,rptno, tblNodes, tblBeams,tblReactions, etc
CreateTable staadObj, rptno, tblNodes, nTableRows
'Now fill the data
FillTable staadObj,rptno, tblNodes, EnvRow, nTableRows, nCols
End Sub
Sub ResetEnvTable(EnvRow() As String, nTableRows As Integer, nCols As Integer)
Dim i As Integer, j As Integer
For i = 1 To nCols
For j = 1 To nTableRows
EnvRow(j,i)="*"
Next j
Next i
'Row lables
EnvRow(1,1) = "Max X"
EnvRow(2,1) = "Min X"
EnvRow(3,1) = "Max Y"
EnvRow(4,1) = "Min Y"
EnvRow(5,1) = "Max Z"
EnvRow(6,1) = "Min Z"
EnvRow(7,1) = "Max rX"
EnvRow(8,1) = "Min rX"
EnvRow(9,1) = "Max rY"
EnvRow(10,1) = "Min rY"
EnvRow(11,1) = "Max rZ"
EnvRow (12,1) = "Min rZ"
EnvRow (13,1) = "Max Res."
End Sub
Sub SelectLoadCases(staadObj As Object, EnvList() As Long, lSelectedCasesNum As Integer)
Dim i As Integer
Dim j As Integer
Dim nResult As Integer
Dim iButton As Integer
Dim LCases As Integer
Dim LCCases As Integer
Dim lstLoadNums() As Long
Dim lstAvailableCases() As String
LCases = Loads.GetPrimaryLoadCaseCount()
ReDim lstLoadNums(LCases)
ReDim lstAvailableCases(LCases)
Loads.GetPrimaryLoadCaseNumbers (lstLoadNums)
For i =0 To LCases-1
lstAvailableCases(i)= CStr(lstLoadNums(i)) &" : " & Loads.GetLoadCaseTitle(lstLoadNums(i))
Next i
Dim lstLoadComNum() As Long
LCCases = Loads.GetLoadCombinationCaseCount()
ReDim lstLoadComNum(LCCases)
ReDim Preserve lstLoadNums(LCases+LCCases)
ReDim Preserve lstAvailableCases(LCases+LCCases)
Loads.GetLoadCombinationCaseNumbers(lstLoadComNum)
For i =0 To LCCases-1
lstLoadNums(LCases+i)=lstLoadComNum(i)
lstAvailableCases(LCases+i)= CStr(lstLoadNums(LCases+i)) &" : " & Loads.GetLoadCaseTitle(lstLoadNums(LCases+i))
Next i
Dim lstSelectedCases() As String
lSelectedCasesNum = 0
ReDim Preserve lstSelectedCases(lSelectedCasesNum)
lstSelectedCases(0) = "(None)"
'Select load case dialog
Begin Dialog UserDialog 720,287,"Select Load Cases and Combinations" ' %GRID:10,7,1,1
Text 20,7,170,14,"Available Cases:-",.Text1
ListBox 20,28,310,175,lstAvailableCases(),.AvailableListBox
PushButton 350,98,40,28,">",.PushButton1
PushButton 70,210,200,28,"Add All Cases",.AddAll
Text 420,7,170,14,"Selected Cases:-",.Text2
ListBox 410,28,290,175,lstSelectedCases(),.SelectedListBox
PushButton 460,210,200,28,"Exclude Selected Case",.PushButton2
OKButton 270,259,90,21
CancelButton 380,259,90,21
End Dialog
Dim dlg As UserDialog
'dlg.SelectedListBox = 1
Do
iButton = Dialog (dlg)
Select Case iButton
Case -1
' OK pressed
If lSelectedCasesNum>0 Then
ReDim EnvList(lSelectedCasesNum)
CreateEnvList EnvList, lstSelectedCases, lSelectedCasesNum
Else
MsgBox "No load cases were selected."
End
End If
Case 0
'Cancel button Pressed
End
Case 1
'Add button pressed
Dim NewLoadCase As String
NewLoadCase = lstAvailableCases(dlg.AvailableListBox)
AddLoadCaseToSelected NewLoadCase, lstSelectedCases, lSelectedCasesNum
Case 2
'Add All cases
lSelectedCasesNum = LCases+LCCases
ReDim lstSelectedCases(lSelectedCasesNum)
For i = 0 To lSelectedCasesNum-1
lstSelectedCases(i) = lstAvailableCases(i)
Next i
Case 3
'Exclude button pressed
Dim RemoveLoadCase As String
'Check if an item selected
If dlg.SelectedListBox >-1 Then
RemoveLoadCase = lstSelectedCases(dlg.SelectedListBox)
ExcludeLoadCaseFromSelected RemoveLoadCase, lstSelectedCases, lSelectedCasesNum
ReDim Preserve lstSelectedCases(lSelectedCasesNum)
End If
Case Else
MsgBox "Error - We should not be here!.", vbOkOnly
End
End Select
Loop Until iButton = -1
End Sub
Sub AddLoadCaseToSelected (NewLoadCase As String, lstSelectedCases() As String, lSelectedCasesNum As Integer)
Dim i As Integer
Dim CaseName As String
'Check if first
If lstSelectedCases(0)="(None)" Then
lstSelectedCases(0) = NewLoadCase
lSelectedCasesNum =1
Else
'Check if selected case is already in list
For i = 1 To lSelectedCasesNum
If NewLoadCase = lstSelectedCases(i-1) Then
GoTo EndSub
End If
Next i
'if not current included, add the selected available load case to the selected list
lSelectedCasesNum = lSelectedCasesNum+1
ReDim Preserve lstSelectedCases(lSelectedCasesNum)
lstSelectedCases(lSelectedCasesNum-1)= NewLoadCase
End If
EndSub:
End Sub
Sub ExcludeLoadCaseFromSelected (RemoveLoadCase As String, lstSelectedCases() As String, lSelectedCasesNum As Integer)
Dim i As Integer, nReduce As Integer
Dim CaseName As String
If lSelectedCasesNum =1 Then
lstSelectedCases(0) = "(None)"
GoTo EndSub
End If
For i = 0 To lSelectedCasesNum-1
If RemoveLoadCase = lstSelectedCases (i) Then
nReduce = 1
If i = lSelectedCasesNum Then
lstSelectedCases(i) = "(last)"
Else
lstSelectedCases(i) = lstSelectedCases(i+1)
RemoveLoadCase = lstSelectedCases(i)
End If
End If
Next i
'remove the selected load case from the selected list
'lSelectedCasesNum = lSelectedCasesNum-1
lSelectedCasesNum = lSelectedCasesNum - nReduce
ReDim Preserve lSelectedCases(lSelectedCasesNum)
EndSub:
End Sub
Sub CreateEnvList (EnvList() As Long, lstSelectedCases() As String, lSelectedCasesNum As Integer)
Dim i As Integer
For i = 1 To lSelectedCasesNum
EnvList(i) = Val(lstSelectedCases(i-1))
Next i
End Sub
Sub FillTable (staadObj As Object, rptno As Long, tblNodeDisplacement As Long, EnvRow() As String, nRows As Integer, nCols As Integer)
Dim i As Integer, j As Integer
For i = 1 To nRows
For j =1 To nCols
Tables.SetCellValue(rptno,tblNodeDisplacement,i,j, EnvRow(i,j))
Next j
Next i
End Sub
Sub CreateTable(staadObj As Object, rptno As Long, tblNodeDisplacement As Long, NoRows As Integer)
Dim unit As Integer
Dim ForceLabel As String, DistanceLabel As String
unit = staadObj.GetBaseUnit
Select Case unit
Case 1 ' English
DistanceLabel ="in"
ForceLabel="kiP"
Case 2 'Metric
'DistanceLabel ="m"
'Displacements for metric models will generally be wanted in mm
DistanceLabel ="mm"
ForceLabel="kN"
Case Else 'This should not occur!
DistanceLabel ="**"
ForceLabel="???"
End Select
'Table name
rptno = Tables.CreateReport("User Envelopes")
'Table sheet name, number of rows and columns
tblNodeDisplacement = Tables.AddTable(rptno, "Node Displacements", NoRows, 10)
'tblEndForce = staad.Table.AddTable(rptno, "End Forces", NoRows, 10)
'tblReaction = staad.Table.AddTable(rptno, "Reactionss", NoRows, 10)
'Column headings
Tables.SetColumnHeader rptno, tblNodeDisplacement, 1, "(Type)"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 1, "")
Tables.SetColumnHeader rptno, tblNodeDisplacement, 2, "Node"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 2, "")
Tables.SetColumnHeader rptno, tblNodeDisplacement, 3, "L/C"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 3, "")
Tables.SetColumnHeader rptno, tblNodeDisplacement, 4, "X"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 4, DistanceLabel)
Tables.SetColumnHeader rptno, tblNodeDisplacement, 5, "Y"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 5, DistanceLabel)
Tables.SetColumnHeader rptno, tblNodeDisplacement, 6, "Z"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 6, DistanceLabel)
Tables.SetColumnHeader rptno, tblNodeDisplacement, 7, "Resultant"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 7, DistanceLabel)
Tables.SetColumnHeader rptno, tblNodeDisplacement, 8, "rX"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 8, "deg")
Tables.SetColumnHeader rptno, tblNodeDisplacement, 9, "rY"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 9, "deg")
Tables.SetColumnHeader rptno, tblNodeDisplacement, 10, "rZ"
Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 10, "deg")
End Sub