rgz1989的博客

抹灰厚度计算 Option Explicit Dim xlExcel As New Excel.Application Dim xlBook As New Excel.Workbook Dim xlSheet As New Excel.Worksheet Dim iRow As Long, jCol As Long, maxf As Long Dim a() As Double Dim maxfe As Integer Dim maxfg As Integer 'Dim AppExcel As Object Private Sub isButton1_Click() CommonDialog1.ShowOpen If Right(CommonDialog1.FileName, 3) <> "xls" Then MsgBox ("非xls有效格式文件") Exit Sub End If Text5.Text = CommonDialog1.FileName List1.Clear ProgressBar1.Max = 1 '读取excel On Error Resume Next xlExcel.Workbooks.Open Text5.Text Set xlBook = xlExcel.Workbooks(1) xlBook.Sheets(1).Select maxf = xlExcel.ActiveSheet.UsedRange.Rows.Count ReDim a(maxf) As Double For iRow = 1 To maxf a(iRow) = xlBook.Worksheets(1).Cells(iRow, 1) ProgressBar1.Value = iRow / maxf DoEvents Next xlBook.Close xlExcel.Quit Set xlSheet = Nothing Set xlBook = Nothing Set xlExcel = Nothing End Sub Private Sub isButton2_Click() If Text2.Text = "" Then MsgBox ("请输入抹灰设计厚度") Exit Sub End If If Text3.Text = "" Then MsgBox ("请输入实际抹灰厚度超过设计厚度的期望百分比") Exit Sub End If If Text5.Text = "" Then MsgBox ("请指定EXCEL数据路径") Exit Sub End If List1.Clear '排序 Dim i As Integer Dim j As Integer Dim temp As Double For i = LBound(a()) To UBound(a()) - 1 For j = LBound(a()) To UBound(a()) - 1 If a(j) > a(j + 1) Then temp = a(j) a(j) = a(j + 1) a(j + 1) = temp End If Next Next '按照期望百分比分割 maxfe = (1 - Text3.Text / 100) * maxf maxfg = Text3.Text / 100 * maxf '前n个 Dim ae() As Double ReDim ae(maxfe) As Double '减掉后的前n个 Dim aej() As Double ReDim aej(maxfe) As Double '后n个 Dim af() As Double ReDim af(maxfg) As Double '得到前n个 For iRow = 1 To maxfe ae(iRow) = a(iRow) Next '得到容许值 Dim zzz As Double zzz = ae(maxfe) - Text2.Text Text4.Text = zzz '第一个数组相减 Dim T As Integer For iRow = 1 To maxfe aej(iRow) = ae(iRow) - zzz '形成正数数组 If aej(iRow) < 0 Then T = iRow End If Next For iRow = 1 To T List1.AddItem (ae(iRow)) Next Dim ttt As Double ttt = T / maxf Text1.Text = Format(ttt, "0.000") End Sub Private Sub Text2_keypress(KeyAscii As Integer) If KeyAscii = 46 And Not CBool(InStr(Text2, ".")) Then Exit Sub If KeyAscii = 8 Then Exit Sub If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 If Text2.Text = "0" And Text2.SelStart = 1 And Chr(KeyAscii) <> "." And KeyAscii <> 8 Then KeyAscii = 0 End Sub Private Sub Text3_keypress(KeyAscii As Integer) If KeyAscii = 46 And Not CBool(InStr(Text2, ".")) Then Exit Sub If KeyAscii = 8 Then Exit Sub If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 If Text3.Text = "0" And Text3.SelStart = 1 And Chr(KeyAscii) <> "." And KeyAscii <> 8 Then KeyAscii = 0 End Sub

ansys 上机指南 非常适合新手用 目 录 Project1 简支梁的变形分析 Project2 坝体的有限元建模与受力分析 Project3 受内压作用的球体的应力与变形分析 Project4 受热载荷作用的厚壁圆筒的有限元建模与温度场求解 Project5 超静定桁架的有限元求解 Project6 超静定梁的有限元求解 Project7 平板的有限元建模与变形分析