YJK整体参数速校表

linxiaoyun 2018.3.31 23:22 107 0
结构设计 软件应用

一、结构整体控制

我们常常根据高规、抗规对结构的整体参数进行概念设计上判断整体规则性,比如常常说到的刚度比等几个比,如下图介绍,控制平面规则、竖向规则、强度刚度稳定性、延性、地震力等。

注意上图中地震影响系数的原点有误。

二、结构整体参数结果读取

在yjk软件中,wmass、wzq、wdisp是常需查阅的文件,几乎包括所有信息,为此设计一张表格,快速检校其中的数据很有必要。如下图表所示:

读取数据形成数据表

通过数据生成简易图表

三、VBA代码实现

VBA实现思路是,读取文件所有行,判断行内容,并填入数据表。思路简单,代码800多行,竟也花了两三天,开源之,分享以输出价值。欢迎同行分享并优化升级。

Sub SelectFile()
    Dim FileName As Variant
     '打开文件对话框返回的文件名,是一个全路径文件名,其值也可能是False,因此类型为Variant
    Dim sFileName As String                         '从FileName中提取的文件名
    Dim sPathName As String                         '从FileName中提取的路径名
    Dim aFile As Variant                            '数组,提取文件名sFileName时使用
    Dim ws As Worksheet                             '存储文件路径名和文件名的工作表
    Set ws = Worksheets("Sheet1")                   '设置工作表
    FileName = Application.GetOpenFilename("wmass 文件 (*.out),*.out")
    '调用Windows打开文件对话框
    If FileName <> False Then                       '如果未按“取消”键
        aFile = Split(FileName, "\")                '在全路径中,以“/”为分隔符,分成数据
        sPathName = aFile(0)                        '取盘符
        For i = 1 To UBound(aFile) - 1              '循环合成路径名
            sPathName = sPathName & "\" & aFile(i)
        Next
        sFileName = aFile(UBound(aFile))            '数组的最后一个元素为文件名
        ws.Cells(1, 2).Value = sPathName            '保存路径名
        'ws.Cells(2, 2).Value = sFileName            '保存文件名
        ws.Cells(2, 2).Value = "wmass.out"
        'SelectFile = sFileName
    End If
End Sub      '选择打开文件后并没有真实的把它打开。

Sub bb()
Dim a, b, k%, i%, j%, q%
nn = 100
Worksheets("sheet1").Range("b3:v" & nn).ClearContents
On Error GoTo e1
'filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\" & "wmass.out"
If Worksheets("Sheet1").Cells(1, 2).Value = "" Then
e1:
Call SelectFile
End If
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\" & "wmass.out"
Open filename1 For Input As #1
 a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   Close #1
   
k = UBound(a)
flag1 = False
flag2 = False

plotorih = 800
dataorilinen = 6

For i = 0 To k

temp = Application.Trim(a(i))

'''
If temp = "楼层属性" Then
flag1 = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If

If flag1 Then

If temp = "" Then '终止,并归零标志
myfloors = j - 1
flag1 = False
j = 0
GoTo fff
End If

b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 2).Value = b(0)
'Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(1)
j = j + 1

End If
'''

'''
If temp = "各层构件数量、构件材料和层高" Then
flag1a = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If

If flag1a Then

If temp = "" Then '终止,并归零标志
GoTo fff
End If

If j >= myfloors Then
flag1a = False
End If

b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(6)
'Worksheets("Sheet1").Cells(dataorilinen + j, 3).Value = b(1)
j = j + 1

End If 'flag1a
'''


'''
If temp = "各楼层质量、单位面积质量分布(单位:kg/m**2)" Then
flag2 = True '层号相应标志
j = 0 '取各层计数
i = i + 2
GoTo fff
End If

If flag2 Then

If temp = "" Then '终止,并归零标志
flag2 = False
j = 0
GoTo fff
End If

b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 4).Value = b(3)
Worksheets("Sheet1").Cells(dataorilinen + j, 5).Value = b(4)
j = j + 1

End If 'flag2
'''

If temp = "各层刚心、偏心率、相邻层侧移刚度比等计算信息" Then
flag3 = True '层号相应标志
j = 0 '取各层计数
Worksheets("Sheet1").Cells(dataorilinen + j, 6).Value = "Ratx1="
Worksheets("Sheet1").Cells(dataorilinen + j, 7).Value = "Raty1="
Worksheets("Sheet1").Cells(dataorilinen + j, 8).Value = "Ratx2="
Worksheets("Sheet1").Cells(dataorilinen + j, 9).Value = "Raty2="
j = j + 1
i = i + 13
GoTo fff
End If

If flag3 Then

If temp = "" Then '终止,并归零标志
flag3 = False
j = 0
GoTo fff
End If

b = Split(temp, " ")
If b(0) = "Ratx1=" Then
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 6).Value = b(1)
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 7).Value = b(3)
GoTo fff
End If

If b(0) = "Ratx2=" Then
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 8).Value = b(1)
Worksheets("Sheet1").Cells(1 + myfloors + dataorilinen - j, 9).Value = b(3)
j = j + 1
GoTo fff
End If

If b(0) = "X方向最小刚度比:" Then
Worksheets("Sheet1").Cells(dataorilinen - 2, 8).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen - 1, 8).Value = b(1)
temp = Application.Trim(a(i + 1))
b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen - 2, 9).Value = b(0)
Worksheets("Sheet1").Cells(dataorilinen - 1, 9).Value = b(1)
i = i + 1
GoTo fff
End If

End If 'flag3

'''
'''
If temp = "结构整体稳定验算" Then
flag4 = True '层号相应标志
j = 0 '取各层计数
i = i + 6
GoTo fff
End If

If flag4 Then

If temp = "" Then '终止,并归零标志
flag4 = False
j = 0
GoTo fff
End If

Worksheets("Sheet1").Cells(dataorilinen + j, 10).Value = temp
j = j + 1

End If 'flag2
'''

'''
If temp = "楼层抗剪承载力验算" Then
flag5 = True '层号相应标志
j = 0 '取各层计数
i = i + 4
GoTo fff
End If

If flag5 Then

If temp = "" Then '终止,并归零标志
flag5 = False
j = 0
GoTo fff
End If

b = Split(temp, " ")
Worksheets("Sheet1").Cells(dataorilinen + j, 11).Value = b(4)
Worksheets("Sheet1").Cells(dataorilinen + j, 12).Value = b(5)
j = j + 1

End If 'flag2
'''

fff:
Next i


'周期地震力文件
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\wzq.out"
Open filename1 For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1

k = UBound(a)
flag6 = False
flag7 = -1
flag8 = False
For i = 0 To k
temp = Application.Trim(a(i))

'''
If temp = "周期、地震力与振型输出文件" Then
flag6 = True '层号相应标志
j = 0 '取各层计数
i = i + 4
GoTo ggg
End If

If flag6 Then

    '跳过一行
    If temp = "" Then
    GoTo ggg
    End If

    b = Split(temp, " ")


    If j < 6 Then
    Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(1)
    Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
    j = j + 1
    
    ElseIf b(0) = "X向平动振型参与质量系数总计:" Then
            flag7 = 3
    End If ' j<6
            
    If flag7 > 1 Then
    Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(0)
    Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(1)
    flag7 = flag7 - 1
    j = j + 1
    ElseIf flag7 > 0 Then
    Worksheets("Sheet1").Cells(dataorilinen + j, 13).Value = b(0)
    Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(2)
    flag7 = flag7 - 1
    j = j + 1
    
    ElseIf flag7 = 0 Then
    flag6 = False
    flag7 = flag7 - 1
    j = 0
   
    End If 'flag7

End If 'flag6
'''
'''
If temp = "各层 X 方向的作用力(CQC)" Then
flag8 = True '层号相应标志
j = 0 '取各层计数
i = i + 7
GoTo ggg
End If

    If flag8 Then
    
        If j >= myfloors + 2 Then '终止,并归零标志
        flag8 = False
        j = 0
        GoTo ggg
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 15).Value = "X 向剪重比"
        j = j + 1
        GoTo ggg
        End If
        
        If temp = "" Then
        GoTo ggg
        End If
        
        If temp = "(kN) (kN) (kN-m) (kN)" Then
        GoTo ggg
        End If
        
        b = Split(temp, "%")
        
        If j <= myfloors Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 15).Value = Split(b(0), "(")(1) & "%"
        'Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
        j = j + 1
        Else
        Worksheets("Sheet1").Cells(dataorilinen - 2, 15).Value = "X向楼层最小剪重比"
        Worksheets("Sheet1").Cells(dataorilinen - 1, 15).Value = Split(b(0), "=")(1) & "%"
        Worksheets("ref").Range("c1").Value = b(0)
        Worksheets("ref").Range("c" & 1 + dataorilinen & ":c" & dataorilinen + myfloors).Value = Worksheets("Sheet1").Cells(dataorilinen - 1, 15).Value
        j = j + 1
        'flag8 = False
        End If 'j
        
    
    End If 'flag8

    '''

'''
If temp = "各层 Y 方向的作用力(CQC)" Then
flag9 = True '层号相应标志
j = 0 '取各层计数
i = i + 7
GoTo ggg
End If

    If flag9 Then
    
        If j >= myfloors + 2 Then '终止,并归零标志
        flag9 = False
        j = 0
        GoTo ggg
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 16).Value = "Y 向剪重比"
        j = j + 1
        GoTo ggg
        End If
        
        If temp = "" Then
        GoTo ggg
        End If
        
        If temp = "(kN) (kN) (kN-m) (kN)" Then
        GoTo ggg
        End If
        
        b = Split(temp, "%")
        '跳过一行

        
        If j <= myfloors Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 16).Value = Split(b(0), "(")(1) & "%"
        'Worksheets("Sheet1").Cells(dataorilinen + j, 14).Value = b(3)
        j = j + 1
        Else
        Worksheets("Sheet1").Cells(dataorilinen - 2, 16).Value = "Y向楼层最小剪重比"
        Worksheets("Sheet1").Cells(dataorilinen - 1, 16).Value = Split(b(0), "=")(1) & "%"
        Worksheets("ref").Range("d1").Value = b(0)
        Worksheets("ref").Range("d" & 1 + dataorilinen & ":d" & dataorilinen + myfloors).Value = Worksheets("Sheet1").Cells(dataorilinen - 1, 16).Value
        j = j + 1
        'flag9 = False
        End If 'j
        
    
    End If 'flag9

    '''

ggg:
    Next i
    
    
'位移输出文件
filename1 = Worksheets("Sheet1").Cells(1, 2).Value & "\wdisp.out"
Open filename1 For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
Close #1

k = UBound(a)

flag10 = False
For i = 0 To k
temp = Application.Trim(a(i))


        
'''
If InStr(11, temp, "X 方向地震作用下的楼层最大位移") > 0 Then
flag10 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If

    If flag10 Then
    
        If j > myfloors Then  '终止,并归零标志
        flag10 = False
        j = 0
        End If
        
        
        If temp = "" Then
        i = i + 1
        GoTo hhh
        End If
        
        b = Split(temp, " ")
        
                '跳过一行
        If b(0) = "X向最大层间位移角:" Then
        Worksheets("Sheet1").Cells(dataorilinen - 1, 17).Value = a(i)
        GoTo hhh
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 17).Value = "X方向地震层间位移角"
        j = j + 1
        End If
        
       
        
        If j <= myfloors Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 17).Formula = "=" & b(3)
     
        i = i + 1 '跳一行
        j = j + 1
        End If 'j
        
    
    End If 'flag10

    '''
    
    '''
If InStr(11, temp, "Y 方向地震作用下的楼层最大位移") > 0 Then
flag11 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If

    If flag11 Then
    
        If j > myfloors Then  '终止,并归零标志
        flag11 = False
        j = 0
        End If
        
        
        If temp = "" Then
        i = i + 1
        GoTo hhh
        End If
        
        b = Split(temp, " ")
        
                '跳过一行
        If b(0) = "Y向最大层间位移角:" Then
        Worksheets("Sheet1").Cells(dataorilinen - 1, 18).Value = a(i)
        GoTo hhh
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 18).Value = "Y方向地震层间位移角"
        j = j + 1
        End If
        
       
        
        If j <= myfloors Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 18).Formula = "=" & b(3)
       
        i = i + 1 '跳一行
        j = j + 1
        End If 'j
    
    End If 'flag11

    '''
    
        '''
If InStr(11, temp, "+X 方向风荷载作用下的楼层最大位移") > 0 Then
flag12 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If

    If flag12 Then
    
        If j > myfloors Then  '终止,并归零标志
        flag12 = False
        j = 0
        End If
       
        
        If temp = "" Then
        i = i + 1
        GoTo hhh
        End If
        
        b = Split(temp, " ")
        
                '跳过一行
        If b(0) = "X向最大层间位移角:" Then
        Worksheets("Sheet1").Cells(dataorilinen - 1, 19).Value = a(i)
        GoTo hhh
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 19).Value = "+X 方向风荷载层间位移角"
        j = j + 1
        End If
        
       
        
        If j <= myfloors Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 19).Formula = "=" & b(4)
       
        i = i + 1 '跳一行
        j = j + 1
        End If 'j
    
    End If 'flag12

    '''
    
If InStr(11, temp, "+Y 方向风荷载作用下的楼层最大位移") > 0 Then
flag13 = True '层号相应标志
j = 0 '取各层计数
i = i + 3
GoTo hhh
End If

    If flag13 Then
    
        If j > myfloors Then  '终止,并归零标志
        flag13 = False
        j = 0
        End If
        
                
        If temp = "" Then
        i = i + 1
        GoTo hhh
        End If
     
        b = Split(temp, " ")
        
                '跳过一行
        If b(0) = "Y向最大层间位移角:" Then
        Worksheets("Sheet1").Cells(dataorilinen - 1, 20).Value = a(i)
        GoTo hhh
        End If
        
        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 20).Value = "+Y 方向风荷载层间位移角"
        j = j + 1
        End If
        
       
        
        If j <= myfloors Then
        If Right(b(4), 1) = "/" Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 20).Formula = "=" & b(4) & b(5)
        Else
        Worksheets("Sheet1").Cells(dataorilinen + j, 20).Formula = "=" & b(4)
        End If 'right
        i = i + 1 '跳一行
        j = j + 1
        End If 'j
    
    End If 'flag13

    '''
     
If InStr(11, temp, "X 方向规定水平力作用下的楼层最大位移") > 0 Then
flag14 = True '层号相应标志
j = 0 '取各层计数
jj = 0
i = i + 3
GoTo hhh
End If

    If flag14 Then
    

        If j = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 21).Value = "X方向位移比"
        j = j + 1
        End If
        
        If jj = 0 Then
        Worksheets("Sheet1").Cells(dataorilinen + jj, 22).Value = "Y方向位移比"
        jj = jj + 1
        End If
        
                
        If temp = "" Then
       'i = i + 1
        GoTo hhh
        End If
        
        b = Split(temp, " ")
        
               
        If b(0) = "X方向最大层间位移与平均层间位移的比值:" Then
        Worksheets("Sheet1").Cells(dataorilinen + j, 21).Value = b(1)
        j = j + 1
        GoTo hhh
        End If
        
        If b(0) = "Y方向最大层间位移与平均层间位移的比值:" Then
        Worksheets("Sheet1").Cells(dataorilinen + jj, 22).Value = b(1)
        jj = jj + 1
        GoTo hhh
        End If

    End If 'flag14

    '''
    
hhh:
    Next i

'作图
plotorih = (dataorilinen + myfloors + 6) * 14.25
   Set rng2 = Worksheets("sheet1").Range("b" & 1 + dataorilinen & ":b" & dataorilinen + myfloors)

   mycoln = "d"
   Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
   Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
   'Set rng4 = Worksheets("ref").Range("a4:a" & 3 + myfloors)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot(0, rng1, rng2, rng3, plotorih)
    
    Set rng4 = Worksheets("ref").Range("a" & 1 + dataorilinen & ":a" & dataorilinen + myfloors)

   
    mycoln = "f"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)
    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(1, rng1, rng2, rng3, rng4, plotorih)
    
    mycoln = "g"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(2, rng1, rng2, rng3, rng4, plotorih)
    
    'Set rng4 = Worksheets("ref").Range("b4:a" & 3 + myfloors)

    mycoln = "h"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(3, rng1, rng2, rng3, rng4, plotorih)
    
    mycoln = "i"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(3, rng1, rng2, rng3, rng4, plotorih)
    
    Set rng4 = Worksheets("ref").Range("b" & 1 + dataorilinen & ":b" & dataorilinen + myfloors)

    
    mycoln = "k"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(4, rng1, rng2, rng3, rng4, plotorih)
    
    mycoln = "l"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(5, rng1, rng2, rng3, rng4, plotorih)
    
    
    Set rng4 = Worksheets("ref").Range("c" & 1 + dataorilinen & ":c" & dataorilinen + myfloors)
    mycoln = "o"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(0, rng1, rng2, rng3, rng4, plotorih, 1)
    
    Set rng4 = Worksheets("ref").Range("d" & 1 + dataorilinen & ":d" & dataorilinen + myfloors)
    mycoln = "p"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot2(1, rng1, rng2, rng3, rng4, plotorih, 1)
    
    mycoln = "q"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot(2, rng1, rng2, rng3, plotorih, 1)
    
    mycoln = "r"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot(3, rng1, rng2, rng3, plotorih, 1)
    
    mycoln = "s"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot(4, rng1, rng2, rng3, plotorih, 1)
    
    mycoln = "t"
    Set rng1 = Worksheets("sheet1").Range(mycoln & 1 + dataorilinen & ":" & mycoln & dataorilinen + myfloors)
    Set rng3 = Worksheets("sheet1").Range(mycoln & dataorilinen)

    Call minmax(rng1.Column, dataorilinen, myfloors, rng1)
    Call myplot(5, rng1, rng2, rng3, plotorih, 1)
    

'myplot (myfloors)
End Sub

Sub myplot(indexh As Integer, rng1, rng2, rng3, plotorih, Optional indexv As Integer = 0)
'
' 宏1 宏

On Error GoTo err:
Worksheets("sheet1").ChartObjects(rng3.Text).Delete   '确保这是唯一的图
err:

   'Set rng1 = Worksheets("sheet1").Range("d4:d" & 3 + myfloors)
   'Set rng2 = Worksheets("sheet1").Range("b4:b" & 3 + myfloors)
  ' Set rng3 = Worksheets("sheet1").Range("D3")
   Set ch = Worksheets("sheet1").ChartObjects.Add(50 + 200 * indexh, plotorih + indexv * 300, 200, 300)
   ch.Name = rng3.Text
   With ch.Chart
            .ChartType = xlXYScatterLinesNoMarkers
    'ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
    'ActiveChart.SetSourceData Source:=Range("Sheet1!$D$4:$D$31,Sheet1!$B$4:$B$31")
            .SeriesCollection.NewSeries    '这个必须得有
            .SeriesCollection(1).Values = rng2
            .SeriesCollection(1).XValues = rng1
            .SeriesCollection(1).Name = rng3.Text
           
    End With
    

    Set ch = Nothing
    
    End Sub

Sub myplot2(indexh As Integer, rng1, rng2, rng3, rng4, plotorih, Optional indexv As Integer = 0)
'
' 宏1 宏

On Error GoTo err:
Worksheets("sheet1").ChartObjects(rng3.Text).Delete   '确保这是唯一的图
err:

   'Set rng1 = Worksheets("sheet1").Range("d4:d" & 3 + myfloors)
   'Set rng2 = Worksheets("sheet1").Range("b4:b" & 3 + myfloors)
  ' Set rng3 = Worksheets("sheet1").Range("D3")
   Set ch = Worksheets("sheet1").ChartObjects.Add(50 + 200 * indexh, plotorih + indexv * 300, 200, 300)
   ch.Name = rng3.Text
   With ch.Chart
            .ChartType = xlXYScatterLinesNoMarkers
    'ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
    'ActiveChart.SetSourceData Source:=Range("Sheet1!$D$4:$D$31,Sheet1!$B$4:$B$31")
            .SeriesCollection.NewSeries    '这个必须得有
            .SeriesCollection(1).Values = rng2
            .SeriesCollection(1).XValues = rng1
            .SeriesCollection(1).Name = rng3.Text
            .SeriesCollection.NewSeries    '这个必须得有
            .SeriesCollection(2).Values = rng2
            .SeriesCollection(2).XValues = rng4
            .SeriesCollection(2).Name = "限值"
           
    End With
    

    Set ch = Nothing
    
    End Sub

Sub minmax(coln, dataorilinen, myfloors, rng1)
   Worksheets("Sheet1").Cells(dataorilinen + myfloors + 1, coln).Value = Application.Min(rng1)
   Worksheets("Sheet1").Cells(dataorilinen + myfloors + 2, coln).Value = Application.Max(rng1)
End Sub

Sub mysplit()
filename1 = Worksheets("Sheet1").Cells(2, 2).Value
a = Split(filename1, "\")
End Sub

Sub saveold()
nn = 100
Application.ScreenUpdating = False '关闭屏幕刷新
Worksheets("temp").Range("b3:v" & nn).ClearContents
nn = Worksheets("sheet1").[D65535].End(xlUp).Row
Worksheets("sheet1").Range("b1:v" & nn).Copy Worksheets("temp").Range("b1:v" & nn)
Application.ScreenUpdating = True '打开屏幕刷新
End Sub

以上。

四、下载使用

点击生成按钮,将一键生成图表:自动更新非填充区数据,及简易图表,以便于快速查阅结构整体参数。切换项目目录仅需删除B1单元格数据,注意提示选择文件时,应选择wmass.out文件。本表格使用VBA,需要同意启动宏。

YJK结构整体参数速校表

赞助作者请加微信hnuliulinhai,传递价值,共享快乐。

五、升级

工作表sheet1生成数据,按钮保存将sheet1工作表数据拷贝至工作表temp,工作表dif中可以查看上述两表的差别。按新调整过的模型结果生成数据,然后表dif中进行对应单元格比较,可以粗略判断调整模型后的变化。

六、注意

此表格仅为摘要,仍应多次查看原wmass等文件,避免以偏概全。

 

Last Modified·2018年4月7日 09:49

暂无评论

您尚未登录,请先才能评论。