[VBA函数]：应力弧垂专用计算代码（VB）

liweisbdgv

不懂VB的别看　下了也看不懂~!!!!!!!!!!!!!!!不喜欢的走开　表骂人~
最后运行的结果生成一个ｅｘｃｅｌ表格　我这里有一个利用此表格绘出应力弧垂曲线的VBA代码　要在
CAD中加载　需要的可以M我

Dim a As Single, B As Single　'这里不需要更改　是应力计算子过程
Public Sub newton(ByVal x0!, x!, ByVal eps!)
Dim fx!, f1x!
Do
fx = x0 * x0 * x0 - a * x0 * x0 - B
f1x = 3 * x0 * x0 - 2 * a * x0
x = x0 - fx / f1x
If Abs(x - x0) < eps Then Exit Do
x0 = x
Loop
End Sub

Private Sub Command1_Click()
Const α As Double = 0.0000189, E As Long = 76000　'膨胀系数和弹性模量　改成你的导线的
Dim σ1 As Single, σ2 As Single, r1 As Single, r2 As Single
Dim t1 As Integer, t2 As Integer, l As Single

Dim aa(1 To 10, 1 To 2) As Single
aa(1, 1) = 40: aa(1, 2) = 34.05'以下是10个气象条件下的　温度和比在
aa(2, 1) = -10: aa(2, 2) = 34.05
aa(3, 1) = 10: aa(3, 2) = 65.24
aa(4, 1) = -5: aa(4, 2) = 87.86
aa(5, 1) = 15: aa(5, 2) = 38.78
aa(6, 1) = 15: aa(6, 2) = 34.05
aa(7, 1) = 15: aa(7, 2) = 35.03
aa(8, 1) = -5: aa(8, 2) = 35.03
aa(9, 1) = -5: aa(9, 2) = 34.05
aa(10, 1) = 15: aa(10, 2) = 34.05
Dim w(1 To 4, 1 To 3) As Single
w(1, 1) = 87.86: w(1, 2) = -5: w(1, 3) = 121.94 'a　4个控制气象条件的比在　温度和应力　当然我的只有A和C控　所以只要输入A.C的
w(2, 1) = 65.24: w(2, 2) = 10  'b
w(3, 1) = 34.05: w(3, 2) = 15: w(3, 3) = 76.215 'c
w(4, 1) = 34.05: w(4, 2) = -10 'd

       '比在        温度           应力
      
   
    Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
    xlApp.Visible = True '设置EXCEL可见
    Set xlBook = xlApp.Workbooks.Open("C:\document. and Settings\kitty\桌面\sheji.xls") '打开EXCEL工作簿　注意这个表格是用来存放计算出来的应力弧垂的

For i = 1 To 10

r2 = aa(i, 2) * 0.001
t2 = aa(i, 1)

For ll = 0 To 600 Step 50

If ll < 129.506 Then　'我只有一个临界档距　如果你有几个的话可以自己加判断
  r1 = w(3, 1) * 0.001: t1 = w(3, 2): σ1 = w(3, 3)
Else
  r1 = w(1, 1) * 0.001: t1 = w(1, 2): σ1 = w(1, 3)
End If
If ll = 100 Then l = 129.506 Else l = ll　


      a = σ1 - E * r1 ^ 2 * l ^ 2 / (24 * σ1 * σ1) - α * E * (t2 - t1)
      B = E * (r2 * r2) * (l ^ 2) / 24


      Call newton(100!, Root!, 0.0001)
      Text6.Text = Str(Root)
      Text8 = (l ^ 2 * aa(i, 2) * 0.001) / (8 * Val(Text6.Text))

      Text6.Text = Format(Text6.Text, "  000.000 ")'精度处理　格式化数据
      Text8.Text = Format(Text8.Text, "#.000")

      aaa = "第" & i & "   " & "档距为" & l & "   " & "应力:" & Text6 & "       " & "弧锤:" & Text8.Text　' 把所有计算结果显示在文本框中
      Text9 = Text9 & aaa & Chr(13) + Chr(10)


   
    Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
    Set xlsheet2 = xlBook.Worksheets(2)
    'xlsheet.Activate '激活工作表
   
    xlsheet.Cells(ll / 50 + 2, i + 1) = Text6 '给单元格1行驶列赋值　　保存应力给ｓｈｅｅｔ1
   ' xlsheet2.Activate
   
    xlsheet2.Cells(ll / 50 + 2, i + 1) = Text8　　保存弧垂给ｓｈｅｅｔ2
    xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL中的启动宏
Next ll
Next i

End Sub



Private Sub Form_Load()
Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类

tline_gy

谢谢提供,可以给我吗?利用此表格绘出应力弧垂曲线的VBA代码