'#Reference {EDA9FA7F-EFC9-4264-9513-39CF6E72604D}#1.0#0#C:\SProV8i SS5\STAAD\OpenStaadUI.tlb#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

Option Explicit

Sub Main()
Dim staadObj As Object
Dim stdFile As String
Dim nResult As Integer
Set staadObj = GetObject(,"StaadPro.OpenSTAAD")

'Make sure STAAD is loaded and running
staadObj.GetSTAADFile(stdFile,"TRUE")

If stdFile <> "" Then	'no file loaded
	'Check there are results
	nResult = staadObj.Output.AreResultsAvailable
	If nResult = 1 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(staad As Object)
	Dim nReturn As Integer
	Dim i As Integer, j As Integer, k As Integer

	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 staad, 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 = staad.Geometry.GetNodeCount()
	ReDim nNode(nNodes)
	staad.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 = staad.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 staad, rptno, tblNodes, nTableRows

	'Now fill the data
	FillTable staad,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(oStd 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 = oStd.Load.GetPrimaryLoadCaseCount()
	ReDim lstLoadNums(LCases)
	ReDim lstAvailableCases(LCases)
	oStd.Load.GetPrimaryLoadCaseNumbers (lstLoadNums)

	For i =0 To LCases-1
		lstAvailableCases(i)= CStr(lstLoadNums(i)) &" : " &  oStd.Load.GetLoadCaseTitle(lstLoadNums(i))
	Next i

	Dim lstLoadComNum() As Long
	LCCases = oStd.Load.GetLoadCombinationCaseCount()
	ReDim lstLoadComNum(LCCases)
	ReDim Preserve lstLoadNums(LCases+LCCases)
	ReDim Preserve lstAvailableCases(LCases+LCCases)
	oStd.Load.GetLoadCombinationCaseNumbers(lstLoadComNum)

	For i =0 To LCCases-1
		lstLoadNums(LCases+i)=lstLoadComNum(i)
		lstAvailableCases(LCases+i)= CStr(lstLoadNums(LCases+i)) &" : " &  oStd.Load.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 (staad 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
				staad.Table.SetCellValue(rptno,tblNodeDisplacement,i,j, EnvRow(i,j))
		Next j
	Next i

End Sub


Sub CreateTable(staad As Object,  rptno As Long, tblNodeDisplacement As Long, NoRows As Integer)
	Dim unit As Integer
	Dim ForceLabel As String, DistanceLabel As String
	unit=staad.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 occur!
			DistanceLabel ="**"
			ForceLabel="???"
		End Select

'Table name
 rptno = staad.Table.CreateReport("User Envelopes")

'Table sheet name, number of  rows and columns
 tblNodeDisplacement = staad.Table.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
 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 1, "(Type)"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 1, "")

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 2, "Node"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 2, "")

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 3, "L/C"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 3, "")

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 4, "X"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 4, DistanceLabel)

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 5, "Y"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 5, DistanceLabel)

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 6, "Z"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 6, DistanceLabel)

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 7, "Resultant"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 7, DistanceLabel)

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 8, "rX"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 8, "deg")

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 9, "rY"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 9, "deg")

 staad.Table.SetColumnHeader rptno, tblNodeDisplacement, 10, "rZ"
 staad.Table.SetColumnUnitString( rptno, tblNodeDisplacement, 10, "deg")

End Sub