[求助]：如何用编程实现临界档距的判定

我爱大自然

求教各位，如何用编程实现临界档距的判定

WYQ4517

本想给你传一个子程序，但牵系的变量太多，你知道，看别人编的程序是最痛苦的事，所以作罢。
你可查查有关导线计算的书，然后编个子程序边试边改。

我爱大自然

wyq4517 ,你好，你还是给我传一个吧，麻烦你了，我自己编了，结果总是不对，我都不知道哪里错了

hnldlixj0

各位：临界档距的意义大不大？

WYQ4517

应1楼主要求，现传上在用的程序的2个过程。希望能见到你最后的结果。
你编好了，我会感到欣慰。

Private Sub qljdj()''求临界档距
''临界档距计算,四个控制条件:1低温;2年均;3复冰;4大风
   Dim j As Byte
   On Error GoTo err
   k(1) = g1 / Xu
   k(2) = g1 / (fz * Xu * kk)
   k(3) = g7 / Xu
   k(4) = g6 / Xu
   g(1) = g1: a(1) = Xu: t(1) = td
   g(2) = g1: a(2) = fz * Xu * kk: t(2) = tp
   g(3) = g7: a(3) = Xu: t(3) = tb
   g(4) = g6: a(4) = Xu: t(4) = tf
   For j = 1 To 4
       p = 0
           For i = 1 To 4
              aa = k(i)
              paixu          ''排序
           Next i
       c(j) = k(Y) '第 j=1 次找到的最大值以 c(1) 替换,y即i
       k(Y) = 0    '摘去大值,再找次大值
       d(j) = Y    '第 j=1 次找到的大值是哪个气象类(如:1--低温)
   Next j
   q = d(4): W = d(3): e = d(2): r = d(1)   'q气象类:c(4);w类:c(3);e类:c(2);r类:c(1)  递增序
   
    '求出6个临界档距：
    l(e, r) = ((24 / tm * (a(r) - a(e)) + 24 * xp * (t(r) - t(e))) / ((g(r) * g(r)) / (a(r) * a(r)) - (g(e) * g(e)) / (a(e) * a(e))))
    l(W, r) = ((24 / tm * (a(r) - a(W)) + 24 * xp * (t(r) - t(W))) / ((g(r) * g(r)) / (a(r) * a(r)) - (g(W) * g(W)) / (a(W) * a(W))))
    l(q, r) = ((24 / tm * (a(r) - a(q)) + 24 * xp * (t(r) - t(q))) / ((g(r) * g(r)) / (a(r) * a(r)) - (g(q) * g(q)) / (a(q) * a(q))))
    l(W, e) = ((24 / tm * (a(e) - a(W)) + 24 * xp * (t(e) - t(W))) / ((g(e) * g(e)) / (a(e) * a(e)) - (g(W) * g(W)) / (a(W) * a(W))))
    l(q, e) = ((24 / tm * (a(e) - a(q)) + 24 * xp * (t(e) - t(q))) / ((g(e) * g(e)) / (a(e) * a(e)) - (g(q) * g(q)) / (a(q) * a(q))))
    l(q, W) = ((24 / tm * (a(W) - a(q)) + 24 * xp * (t(W) - t(q))) / ((g(W) * g(W)) / (a(W) * a(W)) - (g(q) * g(q)) / (a(q) * a(q))))
   k(1) = 0: k(2) = 0: k(3) = 0: k(4) = 0: k(5) = 0: k(6) = 0
            
''以下系东电试研院补充教材判法
If l(e, r) > 0 Then
        k(1) = Sqr(l(e, r))
        If l(W, e) > 0 And l(W, e) < l(e, r) Then
              k(4) = Sqr(l(W, e))
              If l(q, W) > 0 And l(q, W) < l(W, e) Then k(6) = Sqr(l(q, W))
              If l(q, W) > 0 And l(q, W) > l(W, e) Then
                     k(4) = 0
                     If l(q, e) > 0 And l(q, e) < l(e, r) Then k(5) = Sqr(l(q, e))
                     If l(q, e) > 0 And l(q, e) > l(e, r) Then k(1) = 0
                     If l(q, r) > 0 Then k(3) = Sqr(l(q, r))
             End If
        End If
        If l(W, e) > 0 And l(W, e) > l(e, r) Then
              k(1) = 0
              If l(W, r) > 0 Then
                    k(2) = Sqr(l(W, r))
                    If l(q, W) > 0 And l(q, W) < l(W, r) Then k(6) = Sqr(l(q, W))
                    If l(q, W) > 0 And l(q, W) > l(W, r) Then
                           k(2) = 0
                           If l(q, r) > 0 Then k(3) = Sqr(l(q, r))
                    End If
              End If
        End If

      If l(W, e) <= 0 Then
              If l(q, e) > 0 And l(q, e) < l(e, r) Then k(5) = Sqr(l(q, e))
              If l(q, e) > 0 And l(q, e) > l(e, r) Then k(1) = 0
              If l(q, r) > 0 Then k(3) = Sqr(l(q, r))
      End If
End If
If l(e, r) <= 0 Then
      If l(W, r) > 0 Then
              k(2) = Sqr(l(W, r))
              If l(q, W) > 0 And l(q, W) < l(W, r) Then k(6) = Sqr(l(q, W))
              If l(q, W) > 0 And l(q, W) > l(W, r) Then
                 k(2) = 0
                 If l(q, r) > 0 Then k(3) = Sqr(l(q, r))
              End If
      End If
      If l(W, r) <= 0 And l(q, r) > 0 Then k(3) = Sqr(l(q, r))
End If
  
   For j = 1 To 6
       p = 0: Y = 0
           For i = 1 To 6
              aa = k(i)
              paixu                 '排序
           Next i
       c(j) = k(Y) '第 j=1 次找到的最大值以 c(1) 替换,y即i
       k(Y) = 0    '摘去大值,再找次大值
       d(j) = Y    '第 j=1 次找到的大值是哪个气象类(如:1--低温)
   Next j
   ' d(6):  d(5):  d(4):  d(3):  d(2):  d(1)
   ' c(6)   c(5)   c(4)   c(3)   c(2)   c(1)    临界档距递增序
If c(3) = 0 And c(2) = 0 Then
                  lj = c(1)
                  lei = d(1)
                  xxdd          ''子程序
End If
If c(3) = 0 And c(1) = 0 Then
                  lj = c(2)
                  lei = d(2)
                  xxdd
End If
If c(2) = 0 And c(1) = 0 Then
                  lj = c(3)
                  lei = d(3)
                  xxdd
End If

If c(3) = 0 And c(2) <> 0 And c(1) <> 0 Then
                  lei = d(2)
                  xxdd
                  xj1 = xx: sj1 = dd
                  lei = d(1)
                  xxdd
                  xj2 = xx: sj2 = dd
           If sj1 = xj2 Then
              lj1 = c(2)
              lj2 = c(1)
           End If
End If
If c(2) = 0 And c(1) <> 0 And c(3) <> 0 Then
                  lei = d(3): xxdd
                  xj1 = xx: sj1 = dd
                  lei = d(1): xxdd
                  xj2 = xx: sj2 = dd
           If sj1 = xj2 Then
              lj1 = c(3)
              lj2 = c(1)
           End If
End If
If c(1) = 0 And c(3) <> 0 And c(2) <> 0 Then
                  lei = d(3): xxdd
                  xj1 = xx: sj1 = dd
                  lei = d(2): xxdd
                  xj2 = xx: sj2 = dd
           If sj1 = xj2 Then
              lj1 = c(3)
              lj2 = c(2)
           End If
End If
If c(1) <> 0 And c(3) <> 0 And c(2) <> 0 Then
                  lei = d(3): xxdd
                  xj1 = xx: sj1 = dd
                  lei = d(2): xxdd
                  xj2 = xx: sj2 = dd
                  lei = d(1): xxdd
                  xj3 = xx: sj3 = dd
           If sj1 = xj2 And sj2 = xj3 Then
              lj1 = c(3)
              lj2 = c(2)
              lj3 = c(1)
           End If
End If
Exit Sub
err:
    MsgBox ("求临界档距时出错。应审查“防振措施”、“最大代表档距估计值”等。程序将退出。")
    End
End Sub

Private Sub xxdd()
Select Case lei
Case 1
xx = e: dd = r
Case 2
xx = W: dd = r
Case 3
xx = q: dd = r
Case 4
xx = W: dd = e
Case 5
xx = q: dd = e
Case 6
xx = q: dd = W
End Select
End Sub

girllover

好象临界档距比较麻烦的！

sgtw

方程中导、地线比载是否应考虑风压高度变化系数？

我爱大自然

谢谢你这么热心地给我答疑，真的很感谢，祝你一切顺利

WYQ4517

我想知道，帮上了忙没有，即结果如何？

tline_gy

很不错的判断

我爱大自然

WYQ4517 ,我这几天正在弄，估计很快就好了，弄好的话一定会告诉你一声的

momokill

我爱大自然:你可以帮我解释一下WYQ4517的程序吗?
我的邮箱是ffg8435@163com

jonneydpw

金字塔嘛，算起来麻烦，但不能叫难，拿几个数据自己算算，一归类，就明白了，我三年前做个这个小程序：)

w77

下面是我的算法，以0.1米为单位，做了个循环判断，比较便捷，但是效果很好！


Dim ZhuangTai_1 As String, ZhuangTai_2 As String, Count_1 As Integer, St As Double, En As Double, L_linjie As Integer
    Count_1 = 0: St = 500: En = 4000
    Worksheets("档距、弧垂及应力计算").Cells(17, 11).Value = ""
    Worksheets("档距、弧垂及应力计算").Cells(18, 11).Value = ""
    Worksheets("档距、弧垂及应力计算").Cells(19, 11).Value = ""
    Worksheets("档距、弧垂及应力计算").Cells(20, 11).Value = ""
    For L_linjie = 500 To 4000 Step 1
        '1覆冰情况
        k1 = E * r7 ^ 2 * (L_linjie / 10) ^ 2 / 24
        σ_OM1 = Tps / AnQuan_K / A_s
        F_aM1 = k1 / σ_OM1 ^ 2 - (σ_OM1 + WenDu_FB * a * E)
       '2、大风情况
       k2 = E * r6 ^ 2 * (L_linjie / 10) ^ 2 / 24
       σ_OM2 = Tps / AnQuan_K / A_s
       F_aM2 = k2 / σ_OM2 ^ 2 - (σ_OM2 + WenDu_DF * a * E)
       '3年平均气温情况
       k3 = E * r1 ^ 2 * (L_linjie / 10) ^ 2 / 24
       σ_OM3 = Tps * Worksheets("档距、弧垂及应力计算").Cells(2, 8).Value / 100 / A_s
       F_aM3 = k3 / σ_OM3 ^ 2 - (σ_OM3 + WenDu_NJ * a * E)
       '4低温情况
       k4 = E * r1 ^ 2 * (L_linjie / 10) ^ 2 / 24
       σ_OM4 = Tps / AnQuan_K / A_s
       F_aM4 = k4 / σ_OM4 ^ 2 - (σ_OM4 + WenDu_DW * a * E)
      
       If F_aM1 >= F_aM2 Then '覆冰控制
           F_aMax = F_aM1: ZhuangTai_1 = "覆冰控制"
       Else                   '大风控制
           F_aMax = F_aM2: ZhuangTai_1 = "大风控制"
       End If
       If F_aM3 >= F_aMax Then '年平均气温控制
           F_aMax = F_aM3: ZhuangTai_1 = "年平均气温控制"
       End If
       If F_aM4 >= F_aMax Then '低温控制
          F_aMax = F_aM4: ZhuangTai_1 = "低温控制"
       End If
      
       If L_linjie = 500 Then ZhuangTai_2 = ZhuangTai_1

       If Not ZhuangTai_2 = ZhuangTai_1 Then
          En = L_linjie
          If Count_1 = 0 Then
             Worksheets("档距、弧垂及应力计算").Cells(17 + Count_1, 11).Value = CStr(St / 10) + "→" + CStr(En / 10) + "米，为" + ZhuangTai_2
          Else
             Worksheets("档距、弧垂及应力计算").Cells(17 + Count_1, 11).Value = CStr(St / 10) + "→" + CStr(En / 10) + "米，为" + ZhuangTai_2
          End If
          ZhuangTai_2 = ZhuangTai_1: Count_1 = Count_1 + 1: St = En
       End If
      
       If L_linjie = 4000 Then
          Worksheets("档距、弧垂及应力计算").Cells(17 + Count_1, 11).Value = CStr(St / 10) + "→" + CStr(4000 / 10) + "米，为" + ZhuangTai_2
       End If
    Next L_linjie

momokill

w77 ：用什么软件计算？
我用VC编译出现以下错误，
E:\Documents and Settings\Administrator\Cpp1.cpp(1) : error C2146: syntax error : missing ';' before identifier 'ZhuangTai_1'
E:\Documents and Settings\Administrator\Cpp1.cpp(1) : error C2501: 'Dim' : missing storage-class or type specifiers
E:\Documents and Settings\Administrator\Cpp1.cpp(1) : fatal error C1004: unexpected end of file found
请指教？