Quantcast
Channel: RAM | STAAD Forum - Recent Threads
Viewing all articles
Browse latest Browse all 16762

Macro Code

$
0
0

Hi 

I have Macro code which works fine with Staad Pro 2007 but it is not working with Staad Pro V8i SS6. Can anyone help me how to change it . I am beginner for VBA.

 

Private mom_row As Integer

 

Public Sub Auto_Open()

        Const capMenu = " PJ"

        Const capItem2 = "Get Data for Moment Conn"

        Const capItem1 = "Get Data for Shear Conn"

        Const capAction2 = "GetMomentConnections"

        Const capAction1 = "GetShearConnections"

        Dim mb As MenuBar

        Dim mi As MenuItem

        Dim bMakeMenu As Boolean

        Dim bMakeItem As Boolean

        Dim msg As String

        Set mb = MenuBars(xlWorksheet)

        Const ErrMenusMethodMenuBar = 1004

        bMakeMenu = False

        bMakeItem = True

start:

On Error GoTo CheckError

        If bMakeMenu = True Then

                mb.Menus.Add Caption:=capMenu

        End If

        For Each mi In mb.Menus(capMenu).MenuItems

                If mi.Caption = capItem1 Then bMakeItem = False

        Next mi

        For Each mi In mb.Menus(capMenu).MenuItems

                If mi.Caption = capItem2 Then bMakeItem = False

        Next mi

        If bMakeItem = True Then

                mb.Menus(capMenu).MenuItems.Add Caption:=capItem1, OnAction:=capAction1, before:=1

                mb.Menus(capMenu).MenuItems.Add Caption:=capItem2, OnAction:=capAction2, before:=1

        End If

        Exit Sub

CheckError:

        Select Case Err

                Case ErrMenusMethodMenuBar

                        bMakeMenu = True

                        GoTo start

                Case Else

                        msg = "Error has occured. " & Chr(13) & Chr(10) & Error(Err) & "(Error No." & Str(Err) & ")"

                        MsgBox msg, vbExclamation, titleMsg

                        Resume Next

                End

        End Select

End Sub

 

Private Function Initialize()

        MsgBox Chr(13) + Chr(10) + _

                   "GET STAAD DATA FOR CONNECTION CHECK" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _

                   "This add-in collects the STAAD member data and prints it to " + Chr(13) + Chr(10) + _

                   "the input sheets for Moment and Shear Check." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _

                   "Version : 1.13" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _

                   "Author : xxxxxxxx" + Chr(13) + Chr(10) _

                    , vbInformation, titleMsg

End Function

 

Function GetShearConnections()

    Initialize

    Dim FileName As String

    Dim objOpenStaad As Output

    Dim StartLevel As Double

    Dim EndLevel As Double

    Dim MemberCount As Long

    Dim SectionName As String

    Dim nWidth As Double

    Dim nDepth As Double

    Dim pdax As Double

    Dim pday As Double

    Dim pdaz As Double

    Dim pdix As Double

    Dim pdiy As Double

    Dim pdiz As Double

    Dim spX As Double

    Dim spY As Double

    Dim spZ As Double

    Dim epX As Double

    Dim epY As Double

    Dim epZ As Double

    Dim nTruss As Integer

    Dim nShape As Integer

    Dim bSteel As Boolean

    Dim nMemberNos() As Long

    Dim nStartNode() As Long

    Dim nEndNode() As Long

    Dim pnStart As Integer

    Dim pnEnd As Integer

    Dim pnDOFs(6) As Integer

    Dim pnDOFe(6) As Integer

    Dim nrow As Integer

 

    StartLevel = -100000000

    EndLevel = 100000000

    FileName = Application.GetOpenFilename(fileFilter:="STAAD FILE (*.std),*.std", Title:="Choose STAAD FILE")

   

    Application.Sheets("INPUT (Shear)").Activate

    Set objOpenStaad = CreateObject("OpenSTAAD.Output.1")

    objOpenStaad.SelectSTAADFile FileName

    objOpenStaad.GetMembersCount MemberCount

    ReDim nMemberNos(MemberCount)

    ReDim nStartNode(MemberCount)

    ReDim nEndNode(MemberCount)

    objOpenStaad.GetAllMembersIncidences nMemberNos(0), nStartNode(0), nEndNode(0)

   

    nrow = 6

    For j = 1 To MemberCount

        bSteel = False

        objOpenStaad.GetMemberPropertyShape nMemberNos(j - 1), nShape

        objOpenStaad.IsMemberATrussMember nMemberNos(j - 1), nTruss

        If Not nShape = 3 Then

            bSteel = True

        End If

        If bSteel And nTruss < 1 Then

            objOpenStaad.GetMemberDesignProperties nMemberNos(j - 1), SectionName, nWidth, nDepth, pdax, pday, pdaz, pdix, pdiy, pdiz

            objOpenStaad.DoesMemberHaveReleases nMemberNos(j - 1), pnStart, pnEnd

            objOpenStaad.GetNodeCoordinates nStartNode(j - 1), spX, spY, spZ

            objOpenStaad.GetNodeCoordinates nEndNode(j - 1), epX, epY, epZ

            objOpenStaad.GetDOFReleasedAtStartOfMember nMemberNos(j - 1), pnDOFs(0)

            objOpenStaad.GetDOFReleasedAtEndOfMember nMemberNos(j - 1), pnDOFe(0)

           

            If (spY = epY Or Abs(spY - epY) * 0.0254 < 0.3) And spY * 0.0254 >= StartLevel And spY * 0.0254 <= EndLevel Then

                If Not pnStart < 1 And Not pnDOFs(5) < 1 Then

                    Cells(nrow, 1).Value = nMemberNos(j - 1)

                    Cells(nrow, 2).Value = nStartNode(j - 1)

                    Cells(nrow, 3).Value = Round(spY * 0.0254, 1)

                    Cells(nrow, 4).Value = SectionName

                    GetContdToMember objOpenStaad, nWidth, nStartNode(j - 1), nEndNode(j - 1), nrow, "shear"

                    If Not spY = epY Then

                        Cells(nrow, 13).Value = "CHECK DATA FOR INCLINED BEAM"

                    End If

                    nrow = nrow + 1

                End If

                If Not pnEnd < 1 And Not pnDOFe(5) < 1 Then

                    Cells(nrow, 1).Value = nMemberNos(j - 1)

                    Cells(nrow, 2).Value = nEndNode(j - 1)

                    Cells(nrow, 3).Value = Round(epY * 0.0254, 1)

                    Cells(nrow, 4).Value = SectionName

                    GetContdToMember objOpenStaad, nWidth, nEndNode(j - 1), nStartNode(j - 1), nrow, "shear"

                    If Not spY = epY Then

                        Cells(nrow, 13).Value = "CHECK DATA FOR INCLINED BEAM"

                    End If

                    nrow = nrow + 1

                End If

            End If

        End If

    Next

    objOpenStaad.CloseSTAADFile

    Set objOpenStaad = Nothing

End Function

 

Private Function GetContdToMember(objOpenStaad As Output, p_depth As Double, ps_node As Long, pe_node As Long, nrow As Integer, chk_type As String)

    Dim total_mem As Long

    Dim mem_nos() As Long

    Dim s_node() As Long

    Dim e_node() As Long

    Dim ps_px As Double

    Dim ps_py As Double

    Dim ps_pz As Double

    Dim pe_px As Double

    Dim pe_py As Double

    Dim pe_pz As Double

    Dim s_px As Double

    Dim s_py As Double

    Dim s_pz As Double

    Dim e_px As Double

    Dim e_py As Double

    Dim e_pz As Double

 

    Dim n_truss As Integer

    Dim n_shape As Integer

    Dim n_beta As Double

    Dim s_rel As Integer

    Dim e_rel As Integer

   

    objOpenStaad.GetMembersCount total_mem

    ReDim mem_nos(total_mem)

    ReDim s_node(total_mem)

    ReDim e_node(total_mem)

    objOpenStaad.GetAllMembersIncidences mem_nos(0), s_node(0), e_node(0)

    objOpenStaad.GetNodeCoordinates ps_node, ps_px, ps_py, ps_pz

    objOpenStaad.GetNodeCoordinates pe_node, pe_px, pe_py, pe_pz

 

    Dim t_mem As String

    t_mem = ""

    t_count = 0

    fin_wt = 3

    max_wt = 0

    req_mem = 0

    opp_mem = 0

    per_mem = 0

    top_col = 0

    bot_col = 0

    opp_beam = 0

    set_beta = 0

    a_test = 0

    For j = 1 To total_mem

        If (ps_node = s_node(j - 1) Or ps_node = e_node(j - 1)) Then

            objOpenStaad.GetNodeCoordinates s_node(j - 1), s_px, s_py, s_pz

            objOpenStaad.GetNodeCoordinates e_node(j - 1), e_px, e_py, e_pz

            objOpenStaad.IsMemberATrussMember mem_nos(j - 1), n_truss

            objOpenStaad.GetMemberPropertyShape mem_nos(j - 1), n_shape

            objOpenStaad.GetMemberBetaAngle mem_nos(j - 1), n_beta

            objOpenStaad.DoesMemberHaveReleases mem_nos(j - 1), s_rel, e_rel

            a_test = n_beta

            If (Not (pe_node = s_node(j - 1) Or pe_node = e_node(j - 1))) Then

                If (ps_px = pe_px) Then

                    'a_test = 1

                    If (n_truss < 1 And Not s_py = e_py) Then

                        If (s_py > ps_py Or e_py > ps_py) Then

                            t_mem = "TP"

                            If (n_shape = 3) Then

                                fin_wt = 20

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = 99999

                                End If

                            Else

                                If (ps_node = s_node(j - 1) And s_rel > 0) Or (ps_node = e_node(j - 1) And e_rel > 0) Then

                                    fin_wt = 3

                                Else

                                    fin_wt = 10

                                End If

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = mem_nos(j - 1)

                                End If

                            End If

                            If (n_beta = 90) Then

                                set_beta = 1

                            Else

                                set_beta = 0

                            End If

                            top_col = top_col + 1

                        Else

                            t_mem = "BT"

                            If (n_shape = 3) Then

                                fin_wt = 20

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = 99999

                                End If

                            Else

                                If (ps_node = s_node(j - 1) And s_rel > 0) Or (ps_node = e_node(j - 1) And e_rel > 0) Then

                                    fin_wt = 3

                                Else

                                    fin_wt = 10

                                End If

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = mem_nos(j - 1)

                                End If

                            End If

                            If (n_beta = 90) Then

                                set_beta = 1

                            Else

                                set_beta = 0

                            End If

                            bot_col = bot_col + 1

                        End If

                    ElseIf (n_truss < 1 And s_px = e_px) Then

                        t_mem = "OP"

                        fin_wt = 2

                        opp_beam = opp_beam + 1

                        opp_mem = mem_nos(j - 1)

                    ElseIf (n_truss = 1 And s_px = e_px) Then

                        If (s_pz = ps_pz) Then

                            If ((s_pz - e_pz < 0 And ps_pz - pe_pz < 0) Or (s_pz - e_pz > 0 And ps_pz - pe_pz > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        If (e_pz = ps_pz) Then

                            If ((e_pz - s_pz < 0 And ps_pz - pe_pz < 0) Or (e_pz - s_pz > 0 And ps_pz - pe_pz > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        fin_wt = 1

                    ElseIf (n_truss < 1) Then

                        t_mem = "PP"

                        If (n_shape = 3) Then

                            fin_wt = 15

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = 99999

                            End If

                        Else

                            fin_wt = 8

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = mem_nos(j - 1)

                            End If

                        End If

                        per_mem = mem_nos(j - 1)

                    Else

                        t_mem = "PBR"

                        fin_wt = 1

                    End If

                ElseIf (ps_pz = pe_pz) Then

                    'a_test = 2

                    If (n_truss < 1 And Not s_py = e_py) Then

                        If (s_py > ps_py Or e_py > ps_py) Then

                            t_mem = "TP"

                            If (n_shape = 3) Then

                                fin_wt = 20

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = 99999

                                End If

                            Else

                                If (ps_node = s_node(j - 1) And s_rel > 0) Or (ps_node = e_node(j - 1) And e_rel > 0) Then

                                    fin_wt = 3

                                Else

                                    fin_wt = 10

                                End If

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = mem_nos(j - 1)

                                End If

                            End If

                            If (n_beta = 90) Then

                                set_beta = 0

                            Else

                                set_beta = 1

                            End If

                            top_col = top_col + 1

                        Else

                            t_mem = "BT"

                            If (n_shape = 3) Then

                                fin_wt = 20

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = 99999

                                End If

                            Else

                                If (ps_node = s_node(j - 1) And s_rel > 0) Or (ps_node = e_node(j - 1) And e_rel > 0) Then

                                    fin_wt = 3

                                Else

                                    fin_wt = 10

                                End If

                                If (fin_wt > max_wt) Then

                                    max_wt = fin_wt

                                    req_mem = mem_nos(j - 1)

                                End If

                            End If

                            If (n_beta = 90) Then

                                set_beta = 0

                            Else

                                set_beta = 1

                            End If

                            bot_col = bot_col + 1

                        End If

                    ElseIf (n_truss < 1 And s_pz = e_pz) Then

                        t_mem = "OP"

                        fin_wt = 2

                        opp_beam = opp_beam + 1

                        opp_mem = mem_nos(j - 1)

                    ElseIf (n_truss = 1 And s_pz = e_pz) Then

                        If (s_px = ps_px) Then

                            If ((s_px - e_px < 0 And ps_px - pe_px < 0) Or (s_px - e_px > 0 And ps_px - pe_px > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        If (e_px = ps_px) Then

                            If ((e_px - s_px < 0 And ps_px - pe_px < 0) Or (e_px - s_px > 0 And ps_px - pe_px > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        fin_wt = 1

                    ElseIf (n_truss < 1) Then

                        t_mem = "PP"

                        If (n_shape = 3) Then

                            fin_wt = 15

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = 99999

                            End If

                        Else

                            fin_wt = 8

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = mem_nos(j - 1)

                            End If

                        End If

                        per_mem = mem_nos(j - 1)

                    Else

                        t_mem = "PBR"

                        fin_wt = 1

                    End If

                Else

                    If (n_truss < 1) Then

                        t_mem = "PPI"

                        If (n_shape = 3) Then

                            fin_wt = 14

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = 99999

                            End If

                        Else

                            fin_wt = 7

                            If (fin_wt > max_wt) Then

                                max_wt = fin_wt

                                req_mem = mem_nos(j - 1)

                            End If

                        End If

                        per_mem = mem_nos(j - 1)

                    Else

                        t_mem = "PIBR"

                        fin_wt = 1

                    End If

                    Cells(nrow, 13).Value = "BEAM AT ANGLE. CHECK DATA MANUALLY"

                End If

                t_count = t_count + 1

                'Cells(nrow, 7).Value = a_test

                'Cells(nrow, 8).Value = set_beta

                'Cells(nrow, t_count + 8).Value = Str(mem_nos(j - 1)) + t_mem

            End If

        End If

    Next

   

    Dim n_sec_name As String

    Dim pdw As Double

    Dim pdd As Double

    Dim pdax As Double

    Dim pday As Double

    Dim pdaz As Double

    Dim pdix As Double

    Dim pdiy As Double

    Dim pdiz As Double

    Dim o_sec_name As String

    Dim opdw As Double

    Dim opdd As Double

    Dim p_sec_name As String

    Dim ppdw As Double

    Dim ppdd As Double

    objOpenStaad.GetMemberDesignProperties req_mem, n_sec_name, pdw, pdd, pdax, pday, pdaz, pdix, pdiy, pdiz

    objOpenStaad.GetMemberDesignProperties opp_mem, o_sec_name, opdw, opdd, pdax, pday, pdaz, pdix, pdiy, pdiz

    objOpenStaad.GetMemberDesignProperties per_mem, p_sec_name, ppdw, ppdd, pdax, pday, pdaz, pdix, pdiy, pdiz

   

    If (chk_type = "shear") Then

    '    Cells(nrow, 8).Value = p_depth * 25.4

        If (req_mem = 99999) Then

            Cells(nrow, 5).Value = "Concrete"

            If (max_wt = 20) Then

                Cells(nrow, 6).Value = "SSC"

            Else

                Cells(nrow, 6).Value = "SSB"

            End If

        End If

       

        If (max_wt = 10) Then

            If (set_beta = 1 And pdw * 25.4 > 180) Then

                Cells(nrow, 5).Value = n_sec_name

                Cells(nrow, 6).Value = "SLF"

            ElseIf (pdw * 25.4 < 250) Or (pdw * 25.4 < 180 And set_beta = 1) Then

                Cells(nrow, 13).Value = "COL:" + n_sec_name

                Cells(nrow, 5).Value = "Column"

                Cells(nrow, 6).Value = "SS"

            Else

                If (opp_beam > 0) Then

                    If (Not (p_depth = opdw) And (p_depth - opdw) * 25.4 > 60) Then

                        Cells(nrow, 13).Value = "COL:" + n_sec_name + " OPP BEAM:" + o_sec_name

                        Cells(nrow, 6).Value = "SS"

                        Cells(nrow, 5).Value = "Column"

                    ElseIf (Not (p_depth = opdw) And (p_depth - opdw) * 25.4 < -60) Then

                        Cells(nrow, 13).Value = "OPP BEAM:" + o_sec_name

                        Cells(nrow, 6).Value = "SLW1"

                        Cells(nrow, 5).Value = n_sec_name

                    Else

                        Cells(nrow, 6).Value = "SLW2"

                        Cells(nrow, 5).Value = n_sec_name

                    End If

                Else

                    Cells(nrow, 6).Value = "SLW1"

                    Cells(nrow, 5).Value = n_sec_name

                End If

            End If

        End If

   

        If (max_wt = 8) Then

            Cells(nrow, 5).Value = n_sec_name

            Cells(nrow, 6).Value = "SL"

        End If

        If (max_wt = 7) Then

            Cells(nrow, 5).Value = n_sec_name

            Cells(nrow, 6).Value = "SS"

        End If

       

    End If

    If (chk_type = "mom") Then

            If (top_col = 0) Then

                Cells(nrow, 4).Value = n_sec_name + "T"

            Else

                Cells(nrow, 4).Value = n_sec_name

            End If

        If (set_beta = 1) Then

            Cells(nrow, 6).Value = "EM"

        End If

    End If

End Function

 

Function GetMomentConnections()

    Initialize

    Dim FileName As String

    Dim objOpenStaad As Output

    Dim StartLevel As Double

    Dim EndLevel As Double

    Dim MemberCount As Long

    Dim SectionName As String

    Dim nWidth As Double

    Dim nDepth As Double

    Dim pdax As Double

    Dim pday As Double

    Dim pdaz As Double

    Dim pdix As Double

    Dim pdiy As Double

    Dim pdiz As Double

    Dim spX As Double

    Dim spY As Double

    Dim spZ As Double

    Dim epX As Double

    Dim epY As Double

    Dim epZ As Double

    Dim nTruss As Integer

    Dim nShape As Integer

    Dim bSteel As Boolean

    Dim nMemberNos() As Long

    Dim nStartNode() As Long

    Dim nEndNode() As Long

    Dim pnStart As Integer

    Dim pnEnd As Integer

    Dim pnDOFs(6) As Integer

    Dim pnDOFe(6) As Integer

    Dim nrow As Integer

 

    StartLevel = -100000000

    EndLevel = 100000000

    FileName = Application.GetOpenFilename(fileFilter:="STAAD FILE (*.std),*.std", Title:="Choose STAAD FILE")

   

    Application.Sheets("INPUT (Moment)").Activate

    Set objOpenStaad = CreateObject("OpenSTAAD.Output.1")

    objOpenStaad.SelectSTAADFile FileName

    objOpenStaad.GetMembersCount MemberCount

    ReDim nMemberNos(MemberCount)

    ReDim nStartNode(MemberCount)

    ReDim nEndNode(MemberCount)

    objOpenStaad.GetAllMembersIncidences nMemberNos(0), nStartNode(0), nEndNode(0)

   

    mom_row = 6

    For j = 1 To MemberCount

        bSteel = False

        objOpenStaad.GetMemberPropertyShape nMemberNos(j - 1), nShape

        objOpenStaad.IsMemberATrussMember nMemberNos(j - 1), nTruss

        If Not nShape = 3 Then

            bSteel = True

        End If

        If bSteel And nTruss < 1 Then

            objOpenStaad.GetMemberDesignProperties nMemberNos(j - 1), SectionName, nWidth, nDepth, pdax, pday, pdaz, pdix, pdiy, pdiz

            objOpenStaad.DoesMemberHaveReleases nMemberNos(j - 1), pnStart, pnEnd

            objOpenStaad.GetNodeCoordinates nStartNode(j - 1), spX, spY, spZ

            objOpenStaad.GetNodeCoordinates nEndNode(j - 1), epX, epY, epZ

            objOpenStaad.GetDOFReleasedAtStartOfMember nMemberNos(j - 1), pnDOFs(0)

            objOpenStaad.GetDOFReleasedAtEndOfMember nMemberNos(j - 1), pnDOFe(0)

            If spY = epY And spY * 0.0254 >= StartLevel And spY * 0.0254 <= EndLevel Then

                If pnStart < 1 Then

                    GetContdToMomMember objOpenStaad, nMemberNos(j - 1), nStartNode(j - 1), nEndNode(j - 1)

                ElseIf Not pnStart < 1 And pnDOFs(5) < 1 Then

                    Cells(mom_row, 1).Value = nMemberNos(j - 1)

                    Cells(mom_row, 2).Value = nStartNode(j - 1)

                    Cells(mom_row, 3).Value = Round(spY * 0.0254, 1)

                    Cells(mom_row, 5).Value = SectionName

                    GetContdToMember objOpenStaad, nWidth, nStartNode(j - 1), nEndNode(j - 1), mom_row, "mom"

                    mom_row = mom_row + 1

                End If

                If pnEnd < 1 Then

                    GetContdToMomMember objOpenStaad, nMemberNos(j - 1), nEndNode(j - 1), nStartNode(j - 1)

                ElseIf Not pnEnd < 1 And pnDOFe(5) < 1 Then

                    Cells(mom_row, 1).Value = nMemberNos(j - 1)

                    Cells(mom_row, 2).Value = nEndNode(j - 1)

                    Cells(mom_row, 3).Value = Round(epY * 0.0254, 1)

                    Cells(mom_row, 5).Value = SectionName

                    GetContdToMember objOpenStaad, nWidth, nEndNode(j - 1), nStartNode(j - 1), mom_row, "mom"

                    mom_row = mom_row + 1

                End If

            End If

        End If

    Next

    objOpenStaad.CloseSTAADFile

    Set objOpenStaad = Nothing

End Function

 

Private Function GetContdToMomMember(objOpenStaad As Output, p_memno As Long, ps_node As Long, pe_node As Long)

    Dim total_mem As Long

    Dim mem_nos() As Long

    Dim s_node() As Long

    Dim e_node() As Long

    Dim ps_px As Double

    Dim ps_py As Double

    Dim ps_pz As Double

    Dim pe_px As Double

    Dim pe_py As Double

    Dim pe_pz As Double

    Dim s_px As Double

    Dim s_py As Double

    Dim s_pz As Double

    Dim e_px As Double

    Dim e_py As Double

    Dim e_pz As Double

 

    Dim s_rel As Integer

    Dim e_rel As Integer

    Dim n_truss As Integer

    Dim n_shape As Integer

    Dim n_beta As Double

   

    objOpenStaad.GetMembersCount total_mem

    ReDim mem_nos(total_mem)

    ReDim s_node(total_mem)

    ReDim e_node(total_mem)

    objOpenStaad.GetAllMembersIncidences mem_nos(0), s_node(0), e_node(0)

    objOpenStaad.GetNodeCoordinates ps_node, ps_px, ps_py, ps_pz

    objOpenStaad.GetNodeCoordinates pe_node, pe_px, pe_py, pe_pz

   

    Dim t_mem As String

    t_mem = ""

    t_count = 0

    fin_wt = 3

    max_wt = 0

    req_mem = 0

    opp_mem = 0

    per_mem = 0

    top_col = 0

    bot_col = 0

    opp_beam = 0

    set_beta = 0

    end_rel = 0

    For j = 1 To total_mem

        If (ps_node = s_node(j - 1) Or ps_node = e_node(j - 1)) Then

            objOpenStaad.GetNodeCoordinates s_node(j - 1), s_px, s_py, s_pz

            objOpenStaad.GetNodeCoordinates e_node(j - 1), e_px, e_py, e_pz

            objOpenStaad.DoesMemberHaveReleases mem_nos(j - 1), s_rel, e_rel

            objOpenStaad.IsMemberATrussMember mem_nos(j - 1), n_truss

            objOpenStaad.GetMemberPropertyShape mem_nos(j - 1), n_shape

            objOpenStaad.GetMemberBetaAngle mem_nos(j - 1), n_beta

            If (Not (pe_node = s_node(j - 1) Or pe_node = e_node(j - 1))) Then

                t_count = t_count + 1

                If (ps_px = pe_px) Then

                    If (n_truss < 1 And Not s_py = e_py) Then

                        If (s_py > ps_py Or e_py > ps_py) Then

                            t_mem = "TP"

                            req_mem = mem_nos(j - 1)

                            If (n_beta = 90) Then

                                set_beta = 1

                            Else

                                set_beta = 0

                            End If

                            top_col = top_col + 1

                        Else

                            t_mem = "BT"

                            req_mem = mem_nos(j - 1)

                            If (n_beta = 90) Then

                                set_beta = 1

                            Else

                                set_beta = 0

                            End If

                            bot_col = bot_col + 1

                        End If

                        If (ps_node = s_node(j - 1) And s_rel > 0) Then

                            end_rel = end_rel + 1

                        End If

                        If (ps_node = e_node(j - 1) And e_rel > 0) Then

                            end_rel = end_rel + 1

                        End If

                    ElseIf (n_truss < 1 And s_px = e_px) Then

                        t_mem = "OP"

                    ElseIf (n_truss = 1 And s_px = e_px) Then

                        If (s_pz = ps_pz) Then

                            If ((s_pz - e_pz < 0 And ps_pz - pe_pz < 0) Or (s_pz - e_pz > 0 And ps_pz - pe_pz > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        If (e_pz = ps_pz) Then

                            If ((e_pz - s_pz < 0 And ps_pz - pe_pz < 0) Or (e_pz - s_pz > 0 And ps_pz - pe_pz > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                    ElseIf (n_truss < 1) Then

                        t_mem = "PP"

                    Else

                        t_mem = "PBR"

                    End If

                ElseIf (ps_pz = pe_pz) Then

                    If (n_truss < 1 And Not s_py = e_py) Then

                        If (s_py > ps_py Or e_py > ps_py) Then

                            t_mem = "TP"

                            req_mem = mem_nos(j - 1)

                            If (n_beta = 90) Then

                                set_beta = 0

                            Else

                                set_beta = 1

                            End If

                            top_col = top_col + 1

                        Else

                            t_mem = "BT"

                            req_mem = mem_nos(j - 1)

                            If (n_beta = 90) Then

                                set_beta = 0

                            Else

                                set_beta = 1

                            End If

                            bot_col = bot_col + 1

                        End If

                        If (ps_node = s_node(j - 1) And s_rel > 0) Then

                            end_rel = end_rel + 1

                        End If

                        If (ps_node = e_node(j - 1) And e_rel > 0) Then

                            end_rel = end_rel + 1

                        End If

                    ElseIf (n_truss < 1 And s_pz = e_pz) Then

                        t_mem = "OP"

                    ElseIf (n_truss = 1 And s_pz = e_pz) Then

                        If (s_px = ps_px) Then

                            If ((s_px - e_px < 0 And ps_px - pe_px < 0) Or (s_px - e_px > 0 And ps_px - pe_px > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                        If (e_px = ps_px) Then

                            If ((e_px - s_px < 0 And ps_px - pe_px < 0) Or (e_px - s_px > 0 And ps_px - pe_px > 0)) Then

                                t_mem = "MBR"

                            Else

                                t_mem = "OBR"

                            End If

                        End If

                    ElseIf (n_truss < 1) Then

                        t_mem = "PP"

                    Else

                        t_mem = "PBR"

                    End If

                End If

                'Cells(nrow, t_count + 7).Value = Str(mem_nos(j - 1)) + t_mem

            End If

        End If

    Next

   

    Dim n_sec_name As String

    Dim p_sec_name As String

    Dim pdw As Double

    Dim pdd As Double

    Dim pdax As Double

    Dim pday As Double

    Dim pdaz As Double

    Dim pdix As Double

    Dim pdiy As Double

    Dim pdiz As Double

    objOpenStaad.GetMemberDesignProperties req_mem, n_sec_name, pdw, pdd, pdax, pday, pdaz, pdix, pdiy, pdiz

    objOpenStaad.GetMemberDesignProperties p_memno, p_sec_name, pdw, pdd, pdax, pday, pdaz, pdix, pdiy, pdiz

           

    If (Not end_rel > 0) Then

        If (bot_col > 0) Then

            If (set_beta = 1) Then

                Cells(mom_row, 1).Value = p_memno

                Cells(mom_row, 2).Value = ps_node

                Cells(mom_row, 3).Value = Round(ps_py * 0.0254, 1)

                If (top_col = 0) Then

                    Cells(mom_row, 4).Value = n_sec_name + "T"

                Else

                    Cells(mom_row, 4).Value = n_sec_name

                End If

                Cells(mom_row, 5).Value = p_sec_name

                Cells(mom_row, 6).Value = "EM"

                mom_row = mom_row + 1

            End If

        End If

    End If

   

End Function


Viewing all articles
Browse latest Browse all 16762

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>