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 CONNECT Edition\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