vb过程太大，高手们能否简化此程序，希望高手帮忙，万分感激

[xiaoyuanaiai]

Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)
    Pic1.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
    Pic1.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
    Pic1.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
    Pic1.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
    
    Pic1.Line (0, 0)-(轴长 * 1.25, 0)
    Pic1.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
    Pic1.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic1.CurrentX = -轴长 / 100
    Pic1.CurrentY = 0
    Pic1.Print 0
    
    Pic1.CurrentX = 轴长
    Pic1.CurrentY = 0
    Pic1.Print 轴长
    
    Pic1.CurrentX = 弯矩最大处
    Pic1.CurrentY = 0
    Pic1.Print 弯矩最大处
    
    Pic1.CurrentX = 轴长 * 1.25
    Pic1.CurrentY = 0
    Pic1.Print "X"
    
    Pic1.CurrentX = 轴长 / 50
    Pic1.CurrentY = 最大值 * 1.5
    Pic1.Print "Y"
    
   
    Pic1.CurrentX = 弯矩最大处 * 0.99
    Pic1.CurrentY = 最大值 * 1.32
    Pic1.Print Round(最大值)
    
    'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系2(轴长, 最小值, 弯矩最小处)
    Pic1.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
    Pic1.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
    Pic1.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
    Pic1.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
    
    Pic1.Line (0, 0)-(轴长 * 1.25, 0)
    Pic1.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
    Pic1.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic1.CurrentX = -轴长 / 100
    Pic1.CurrentY = 0
    Pic1.Print 0
    
    Pic1.CurrentX = 轴长
    Pic1.CurrentY = 0
    Pic1.Print 轴长
    
    Pic1.CurrentX = 弯矩最小处
    Pic1.CurrentY = 0
    Pic1.Print 弯矩最小处
    
    Pic1.CurrentX = 轴长 * 1.25
    Pic1.CurrentY = 0
    Pic1.Print "X"
    
    Pic1.CurrentX = 轴长 / 50
    Pic1.CurrentY = 最小值 * 1.5
    Pic1.Print "Y"
    
   
    Pic1.CurrentX = 弯矩最小处 * 0.99
    Pic1.CurrentY = 最小值 * 1.32
    Pic1.Print Round(最小值)
   
    
    'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系3(轴长, 最大值, 弯矩最大处)
    Pic2.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
    Pic2.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
    Pic2.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
    Pic2.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
    
    Pic2.Line (0, 0)-(轴长 * 1.25, 0)
    Pic2.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
    Pic2.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic2.CurrentX = -轴长 / 100
    Pic2.CurrentY = 0
    Pic2.Print 0
    
    Pic2.CurrentX = 轴长
    Pic2.CurrentY = 0
    Pic2.Print 轴长
    
    Pic2.CurrentX = 弯矩最大处
    Pic2.CurrentY = 0
    Pic2.Print 弯矩最大处
    
    Pic2.CurrentX = 轴长 * 1.25
    Pic2.CurrentY = 0
    Pic2.Print "X"
    
    Pic2.CurrentX = 轴长 / 50
    Pic2.CurrentY = 最大值 * 1.5
    Pic2.Print "Y"
    
   
    Pic2.CurrentX = 弯矩最大处 * 0.99
    Pic2.CurrentY = 最大值 * 1.32
    Pic2.Print Round(最大值)
End Sub
Private Sub 坐标系4(轴长, 最小值, 弯矩最小处)
    Pic2.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
    Pic2.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
    Pic2.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
    Pic2.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
    
    Pic2.Line (0, 0)-(轴长 * 1.25, 0)
    Pic2.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
    Pic2.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
    
    Pic2.CurrentX = -轴长 / 100
    Pic2.CurrentY = 0
    Pic2.Print 0
    
    Pic2.CurrentX = 轴长
    Pic2.CurrentY = 0
    Pic2.Print 轴长
    
    Pic2.CurrentX = 弯矩最小处
    Pic2.CurrentY = 0
    Pic2.Print 弯矩最小处
    
    Pic2.CurrentX = 轴长 * 1.25
    Pic2.CurrentY = 0
    Pic2.Print "X"
    
    Pic2.CurrentX = 轴长 / 50
    Pic2.CurrentY = 最小值 * 1.5
    Pic2.Print "Y"
    
   
    Pic2.CurrentX = 弯矩最小处 * 0.99
    Pic2.CurrentY = 最小值 * 1.32
    Pic2.Print Round(最小值)
End Sub

Private Function Fp11(l, xp1, p1, x)
    Fp11 = (1 - xp1 / l) * p1
End Function
Private Function Fp12(l, xp1, p1, x)
    Fp12 = -xp1 * p1 / l
End Function
Private Function Mp11(l, xp1, p1, x)
    Mp11 = (1 - xp1 / l) * p1 * x
End Function
Private Function Mp12(l, xp1, p1, x)
    Mp12 = (1 - xp1 / l) * p1 * x - p1 * (x - xp1)
End Function



Private Sub Command2_Click()
    Pic1.Cls
    Dim y()
    l = Val(Text3.Text)
    ReDim y(l * 1000)
    Max = 0
    Maxx = 0
    Min = 0
    Minx1 = 0
 If Combo1.Text = "简支梁" Then
    If Val(Text1.Text) = 1 Then
        If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
            p1 = Arr(1)
            xp1 = Brr(1)
            For i = 0 To l * 1000
                x = i / 1000
                If x < xp1 Then
                    y(i) = Mp11(l, xp1, p1, x)
                Else
                    y(i) = Mp12(l, xp1, p1, x)
                End If
                If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                End If
            Next i
  'frm扭转计算.Print Max
            坐标系1 l, Max, Maxx  '调用的上面的建坐标系的函数，很好
            For i = 0 To l * 1000
                x = i / 1000
                Pic1.PSet (x, y(i))
                If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
            Next i
                Max = 0
                Maxx = 0
                Min = 0
                Minx1 = 0
                For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xp1
                        y(i) = Fp11(l, xp1, p1, x)
                    Case Else
                        y(i) = Fp12(l, xp1, p1, x)
                End Select
                 If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                ElseIf y(i) < Min Then
                    Min = y(i)
                    Minx1 = x
                End If
            Next i
                 If Abs(Max) > Abs(Min) Then
                    坐标系3 l, Max, Maxx
                 Else
                    坐标系4 l, Min, Minx1
                 End If
               For i = 0 To l * 1000
                x = i / 1000
                 If i = 0 Then
                    Pic2.PSet (x, y(i))
                Else
                    Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                    If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                End If
                If i Mod (50 * l) = 0 Then
                    Pic2.Line (x, y(i))-(x, 0), vbBlue
                End If
            Next i
        End If
     End If
     End If
End Sub

[worldy]

这个代码不算长

[xiaoyuanaiai]

楼上的高手们，我的做的是用vb代码绘制材料力学中的弯曲的弯矩图和剪力图，是力学求解器的一部分，因为用到几个窗体，每个窗体都有部分代码，不好粘贴上去，论坛也不能传压缩文件给高手们看，只能贴了一部分比较重要的代码，在上面Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)后面的是绘制坐标系，Private Function Fp11(l, xp1, p1, x)是绘制函数图象调用的函数表达式，
Private Sub Command2_Click()里面的内容是绘制出弯矩图和剪力图的代码，
ElseIf Val(Text2.Text) = 1 and Val(Text11.Text) = 0 Then '有一个集中力和一个均布力的时候
这个以下的代码是在Private Sub Command2_Click()中的一部分
希望高手们能够看明白，如果高手们想看看所有的，我可以把压缩文件给您，希望高手能够帮忙，因为以前没怎么遇到过过程太大的问题，希望高手帮帮忙，谢谢

[zdingyun]

[Quote=引用 5 楼 xiaoyuanaiai 的回复:]
楼上的高手们，我的做的是用vb代码绘制材料力学中的弯曲的弯矩图和剪力图，是力学求解器的一部分，因为用到几个窗体，每个窗体都有部分代码，不好粘贴上去，论坛也不能传压缩文件给高手们看，只能贴了一部分比较重要的代码，在上面Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)后面的是绘制坐标系，Private Function Fp11(l, xp1, p1, x)是绘制函数图象调用的函数表达……
[/Quote]

所谓过程太大问题的解决方法就是将报错的达过程拆成2个或数个的小过程来解决.
见MSDN解释:
过程太大
当编译时，一个过程编译出来的代码不能超过 64K。这个错误的原因与解决方法如下所示：
编译时此过程编译出来的代码超过 64K。
请将此过程及其他太大的过程拆分成两个或数个较小的过程。

[xiaoyuanaiai]

高手，这只是一部分，还有很多，都是差不多的，比如Private Sub Command2_Click()
中的接着上面的程序

ElseIf Val(Text2.Text) = 1 and Val(Text11.Text) = 0 Then  '有一个集中力和一个均布力的时候
            p1 = Arr(1)
            xp1 = Brr(1)
            q1 = Crr(1)
            xq1 = Drr(1)
            lq1 = Err(1) 'err似乎是错误专用？
        If xp1 <= xq1 Then   '此处要有三种情况
            For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is < xp1
                        y(i) = Mp11(l, xp1, p1, x) + Mq11(l, xq1, lq1, q1, x)
                    Case Is < xq1
                        y(i) = Mp12(l, xp1, p1, x) + Mq11(l, xq1, lq1, q1, x)
                    Case Is < (xq1 + lq1)
                        y(i) = Mp12(l, xp1, p1, x) + Mq12(l, xq1, lq1, q1, x)
                    Case Else
                        y(i) = Mp12(l, xp1, p1, x) + Mq13(l, xq1, lq1, q1, x)
                End Select
                If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                End If
            Next i   'for...next i   不能与if语句交叉，否则会出错的
             坐标系1 l, Max, Maxx
            For i = 0 To l * 1000
                x = i / 1000
                Pic1.PSet (x, y(i))
                If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
            Next i
                Max = 0
                Maxx = 0
                Min = 0
                Minx1 = 0
                For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xp1
                        y(i) = Fp11(l, xp1, p1, x) + Fq11(l, xq1, lq1, q1, x)
                    Case Is <= xq1
                        y(i) = Fp12(l, xp1, p1, x) + Fq11(l, xq1, lq1, q1, x)
                    Case Is <= xq1 + lq1
                        y(i) = Fp12(l, xp1, p1, x) + Fq12(l, xq1, lq1, q1, x)
                    Case Else
                        y(i) = Fp12(l, xp1, p1, x) + Fq13(l, xq1, lq1, q1, x)
                End Select
                 If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                ElseIf y(i) < Min Then
                    Min = y(i)
                    Minx1 = x
                End If
            Next i
                 If Abs(Max) > Abs(Min) Then
                    坐标系3 l, Max, Maxx
                 Else
                    坐标系4 l, Min, Minx1
                 End If
               For i = 0 To l * 1000
                x = i / 1000
                 If i = 0 Then
                    Pic2.PSet (x, y(i))
                Else
                    Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                    If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                End If
                If i Mod (50 * l) = 0 Then
                    Pic2.Line (x, y(i))-(x, 0), vbBlue
                End If
            Next i
         ElseIf xp1 >= xq1 And xp1 <= (xq1 + lq1) Then
            For i = 0 To l * 1000
            x = i / 1000
            Select Case x
            Case Is < xq1
                 y(i) = Mp11(l, xp1, p1, x) + Mq11(l, xq1, lq1, q1, x)
            Case Is < xp1
                 y(i) = Mp11(l, xp1, p1, x) + Mq12(l, xq1, lq1, q1, x)
            Case Is < xq1 + lq1
                 y(i) = Mp12(l, xp1, p1, x) + Mq12(l, xq1, lq1, q1, x)
            Case Else
                y(i) = Mp12(l, xp1, p1, x) + Mq13(l, xq1, lq1, q1, x)
            End Select
                If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                End If
            Next i   'for...next i   不能与if语句交叉，否则会出错的
             坐标系1 l, Max, Maxx
            For i = 0 To l * 1000
                x = i / 1000
                Pic1.PSet (x, y(i))
                If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
            Next i
                Max = 0
                Maxx = 0
                Min = 0
                Minx1 = 0
                For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xq1
                        y(i) = Fp11(l, xp1, p1, x) + Fq11(l, xq1, lq1, q1, x)
                    Case Is <= xp1
                        y(i) = Fp11(l, xp1, p1, x) + Fq12(l, xq1, lq1, q1, x)
                    Case Is <= xq1 + lq1
                        y(i) = Fp12(l, xp1, p1, x) + Fq12(l, xq1, lq1, q1, x)
                    Case Else
                        y(i) = Fp12(l, xp1, p1, x) + Fq13(l, xq1, lq1, q1, x)
                End Select
                 If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                ElseIf y(i) < Min Then
                    Min = y(i)
                    Minx1 = x
                End If
            Next i
                 If Abs(Max) > Abs(Min) Then
                    坐标系3 l, Max, Maxx
                 Else
                    坐标系4 l, Min, Minx1
                 End If
               For i = 0 To l * 1000
                x = i / 1000
                 If i = 0 Then
                    Pic2.PSet (x, y(i))
                Else
                    Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                    If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                End If
                If i Mod (50 * l) = 0 Then
                    Pic2.Line (x, y(i))-(x, 0), vbBlue
                End If
            Next i
         Else
            For i = 0 To l * 1000
            x = i / 1000
            Select Case x
                    Case Is < xq1
                        y(i) = Mp11(l, xp1, p1, x) + Mq11(l, xq1, lq1, q1, x)
                    Case Is < xq1 + lq1
                        y(i) = Mp11(l, xp1, p1, x) + Mq12(l, xq1, lq1, q1, x)
                    Case Is < xp1
                        y(i) = Mp11(l, xp1, p1, x) + Mq13(l, xq1, lq1, q1, x)
                    Case Else
                        y(i) = Mp12(l, xp1, p1, x) + Mq13(l, xq1, lq1, q1, x)
                End Select
                   If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                End If
            Next i   'for...next i   不能与if语句交叉，否则会出错的
             坐标系1 l, Max, Maxx
            For i = 0 To l * 1000
                x = i / 1000
                Pic1.PSet (x, y(i))
                If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
            Next i
                Max = 0
                Maxx = 0
                Min = 0
                Minx1 = 0
                For i = 0 To l * 1000
                x = i / 1000
                Select Case x
                    Case Is <= xq1
                        y(i) = Fp11(l, xp1, p1, x) + Fq11(l, xq1, lq1, q1, x)
                    Case Is <= xq1 + lq1
                        y(i) = Fp11(l, xp1, p1, x) + Fq12(l, xq1, lq1, q1, x)
                    Case Is <= xp1
                        y(i) = Fp11(l, xp1, p1, x) + Fq13(l, xq1, lq1, q1, x)
                    Case Else
                        y(i) = (-xp1 * p1) / l - (q1 * lq1 * (xq1 + (lq1 / 2))) / l
                End Select
                 If y(i) > Max Then
                    Max = y(i)
                    Maxx = x
                ElseIf y(i) < Min Then
                    Min = y(i)
                    Minx1 = x
                End If
            Next i
                 If Abs(Max) > Abs(Min) Then
                    坐标系3 l, Max, Maxx
                 Else
                    坐标系4 l, Min, Minx1
                 End If
               For i = 0 To l * 1000
                x = i / 1000
                 If i = 0 Then
                    Pic2.PSet (x, y(i))
                Else
                    Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
                    If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
                End If
                If i Mod (50 * l) = 0 Then
                    Pic2.Line (x, y(i))-(x, 0), vbBlue
                End If
            Next i
             End If

高手，下面还有都是些类似的，您看看能否简化呢，以前从没遇到过过程太大的问题，希望您能指点一下，万分感激，谢谢

[ningweidong]

你也不说清楚，这个代码要实现什么功能

[熊孩子开学喽]

很多重复的部分用一个循环就可以缩短一大半.
代码也不规范, 看上去很别扭, 有点像是由从前的qbasic程序改过来的感觉.

[-晴天]

将内容相同的重复代码做成自定义过程来调用
将逻辑相同,但变量有所不同的程序做成自定义过程,将变量设置为参数.

[xiaoyuanaiai]

8楼的高手您好，您能否根据5楼的说明帮我稍微简化一下程序呢？我vb学的时间不太长，不知道再怎么简化了，您能否帮帮我呢？现在急着用，万分感激您，谢谢

[王二.麻子]

[Quote=引用 9 楼 xiaoyuanaiai 的回复:]
8楼的高手您好，您能否根据5楼的说明帮我稍微简化一下程序呢？我vb学的时间不太长，不知道再怎么简化了，您能否帮帮我呢？现在急着用，万分感激您，谢谢
[/Quote]
你把代码弄明白了就知道怎么简化了

[xiaoyuanaiai]

谢谢，高手的指点，可是我不太会简化过程，高手能否把上面的程序给我稍微简化一点呢，我学习vb时间不太上，还处在初级阶段，高手能否帮一下忙？谢谢

[xiaoyuanaiai]

[Quote=引用 4 楼 wallescai 的回复:]
很多重复的部分用一个循环就可以缩短一大半.
代码也不规范, 看上去很别扭, 有点像是由从前的qbasic程序改过来的感觉.
[/Quote]
高手，能否给点指点，使代码简化一些呢？谢谢

[xiaoyuanaiai]

[Quote=引用 8 楼 qianjin036a 的回复:]
将内容相同的重复代码做成自定义过程来调用
将逻辑相同,但变量有所不同的程序做成自定义过程,将变量设置为参数.
[/Quote]
高手您好，能否具体的给点指点，刚学vb时间不长，有些地方还不太懂，希望您能够给点指点，谢谢