沙漠骆驼工具箱源码-20 绘制WES剖面曲线（三段复合圆弧型）

woxing1987

工具条： 绘制WES剖面曲线
1 界面


2 代码如下：



Option Explicit '强制要求变量声明
Dim hd As Double  '定义设计水头Hd
Dim n As Double   '定义上游堰坡指数
Dim k As Double  '定义系数k
Dim r1 As Double '定义三段圆弧半径
Dim r2 As Double
Dim r3 As Double
Dim x As Double  '定义x,y 坐标
Dim y As Double
Dim weslayer As AcadLayer
Dim zigao As Single
Dim beishu As Integer
Dim oldtuxinggeshu As Double  '定义画曲线之前 的图形个数
Dim newtuxinggeshu As Double  '定义画曲线之 后的图形个数
Dim biaozhuobj As AcadDimAligned


Dim dimpoint1(0 To 2) As Double
Dim dimpoint2(0 To 2) As Double
Dim dimlocation(0 To 2) As Double
Dim xydian(0 To 2) As Double


Private Sub CommandButton1_Click()
        Me.Hide
        On Error Resume Next
        oldtuxinggeshu = ThisDrawing.ModelSpace.count
        If Trim(TextBox1.Text) = "" Or Trim(TextBox2.Text) = "" Or Trim(TextBox3.Text) = "" Then
                MsgBox "请输入必要的数据", vbCritical, "警告--by沙漠骆驼"
                Me.show
                Exit Sub
        End If
        Set weslayer = ThisDrawing.Layers.Add("WES剖面")
        weslayer.color = acGreen
        ThisDrawing.SetVariable "cecolor", "256" '颜色bylayer
        newtextstyle2    '调用新建字体样式程序
        ThisDrawing.SetVariable "textstyle", "wh_lkx"
        With weslayer
                .LayerOn = True
                .Lock = False
                .Freeze = False
        End With
        ThisDrawing.ActiveLayer = weslayer
        hd = TextBox1.Text
        n = TextBox2.Text
        k = TextBox3.Text
        r1 = 0.5 * hd
        r2 = 0.2 * hd
        r3 = 0.04 * hd


        beishu = ComboBox2.Text
        Dim basepoint As Variant
        Dim qidian(0 To 2) As Double
        Dim zhongdian(0 To 2) As Double
        Dim yuanxin(0 To 2) As Double
        basepoint = ThisDrawing.Utility.GetPoint(, "请拾取插入点:")
        qidian(0) = basepoint(0)
        qidian(1) = basepoint(1)
        Dim templine As AcadLine '定义临时线
        yuanxin(0) = qidian(0)
        yuanxin(1) = qidian(1) - r1
        zhongdian(0) = yuanxin(0) - 0.175 * hd
        zhongdian(1) = yuanxin(1) + (r1 ^ 2 - (0.175 * hd) ^ 2) ^ 0.5
        Dim wesquxian As AcadArc
        Dim banjingyinxian(0 To 5) As Double
        Dim xianduanzhongdian(0 To 2) As Double
        '画第一段圆弧
         Set wesquxian = addarc1(yuanxin, qidian, zhongdian)
        'Set templine = ThisDrawing.ModelSpace.AddLine(yuanxin, qidian)
        Set templine = ThisDrawing.ModelSpace.AddLine(yuanxin, zhongdian) '画的是第一条半径
               
        '添加半径引线R1
        banjingyinxian(0) = (yuanxin(0) + zhongdian(0)) / 2
        banjingyinxian(1) = (yuanxin(1) + zhongdian(1)) / 2
        banjingyinxian(2) = banjingyinxian(0) - 1
        banjingyinxian(3) = banjingyinxian(1) - 1
        banjingyinxian(4) = banjingyinxian(2) - 0.35
        banjingyinxian(5) = banjingyinxian(3)
        ThisDrawing.ModelSpace.AddLightWeightPolyline (banjingyinxian)
        xydian(0) = banjingyinxian(4) + 0.03
        xydian(1) = banjingyinxian(5) + 0.03
        ThisDrawing.ModelSpace.AddText "R1", xydian, 0.2
        
        '添加标注B1
        dimpoint1(0) = basepoint(0)
        dimpoint1(1) = basepoint(1) + 0.2
        dimpoint2(0) = zhongdian(0)
        dimpoint2(1) = basepoint(1) + 0.2
        dimlocation(0) = dimpoint2(0)
        dimlocation(1) = (dimpoint1(1) + dimpoint2(1)) / 2 + 0.3
        Set biaozhuobj = ThisDrawing.ModelSpace.AddDimAligned(dimpoint1, dimpoint2, dimlocation)
        With biaozhuobj
                .ArrowheadSize = 0.06 * beishu '箭头的尺寸
                .TextHeight = 0.2 * beishu   '指定标注文字高度
                .ExtensionLineExtend = 0.1 * beishu '尺寸界线超出尺寸线的距离
                .ExtLineFixedLenSuppress = True '打开固定尺寸界线开关
                .ExtLineFixedLen = 0.1 * beishu '尺寸界线固定长度
                .TextOverride = "B1"
                .TextStyle = "wh_lkx"
                .scalefactor = 1
                .TextGap = 0  ' 放入标注文字时，标注文字与尺寸线之间的距离。
                '.TextPosition = dimlocation
        End With
        
        
        '画第二段圆弧
        Dim tempcircle As AcadCircle  '定义临时圆
        Dim linshidian(0 To 2) As Double '定义临时点
        Dim linshijiaodian As Variant '定义临时的交点 linshijiaodian
        Set tempcircle = ThisDrawing.ModelSpace.AddCircle(zhongdian, r2)
        linshijiaodian = tempcircle.IntersectWith(templine, acExtendNone) '求圆心
        tempcircle.Delete
        yuanxin(0) = linshijiaodian(0)
        yuanxin(1) = linshijiaodian(1)
        qidian(0) = zhongdian(0)
        qidian(1) = zhongdian(1)
        zhongdian(0) = qidian(0) - (0.276 * hd - 0.175 * hd)
        zhongdian(1) = yuanxin(1)
        linshidian(0) = zhongdian(0)
        linshidian(1) = qidian(1)
        Set templine = ThisDrawing.ModelSpace.AddLine(zhongdian, linshidian)
        Set tempcircle = ThisDrawing.ModelSpace.AddCircle(yuanxin, r2)
        linshijiaodian = tempcircle.IntersectWith(templine, acExtendNone)
        zhongdian(0) = linshijiaodian(0)
        zhongdian(1) = linshijiaodian(1)
        templine.Delete
        tempcircle.Delete
        Set wesquxian = addarc1(yuanxin, qidian, zhongdian)
        Set templine = ThisDrawing.ModelSpace.AddLine(yuanxin, zhongdian)
        
        '添加半径引线R2
        banjingyinxian(0) = (yuanxin(0) + zhongdian(0)) / 2
        banjingyinxian(1) = (yuanxin(1) + zhongdian(1)) / 2
        banjingyinxian(2) = banjingyinxian(2)
        banjingyinxian(3) = banjingyinxian(3) + 0.4
        banjingyinxian(4) = banjingyinxian(2) - 0.35
        banjingyinxian(5) = banjingyinxian(3)
        ThisDrawing.ModelSpace.AddLightWeightPolyline (banjingyinxian)
        xydian(0) = banjingyinxian(4) + 0.03
        xydian(1) = banjingyinxian(5) + 0.03
        ThisDrawing.ModelSpace.AddText "R2", xydian, 0.2
        
        '添加标注B2
        dimpoint1(0) = basepoint(0)
        dimpoint1(1) = basepoint(1) + 0.5
        dimpoint2(0) = zhongdian(0)
        dimpoint2(1) = basepoint(1) + 0.5
        dimlocation(0) = dimpoint2(0)
        dimlocation(1) = (dimpoint1(1) + dimpoint2(1)) / 2 + 0.3
        Set biaozhuobj = ThisDrawing.ModelSpace.AddDimAligned(dimpoint1, dimpoint2, dimlocation)
        With biaozhuobj
                .ArrowheadSize = 0.06 * beishu '箭头的尺寸
                .TextHeight = 0.2 * beishu   '指定标注文字高度
                .ExtensionLineExtend = 0.1 * beishu '尺寸界线超出尺寸线的距离
                .ExtLineFixedLenSuppress = True '打开固定尺寸界线开关
                .ExtLineFixedLen = 0.1 * beishu  '尺寸界线固定长度
                .TextOverride = "B2"
                .TextStyle = "wh_lkx"
                .scalefactor = 1
                .TextGap = 0
                '.TextPosition = dimlocation
        End With
        
         '画第三段圆弧
        Set tempcircle = ThisDrawing.ModelSpace.AddCircle(zhongdian, r3)
        linshijiaodian = tempcircle.IntersectWith(templine, acExtendNone) '求圆心
        tempcircle.Delete
        yuanxin(0) = linshijiaodian(0)
        yuanxin(1) = linshijiaodian(1)
        qidian(0) = zhongdian(0)
        qidian(1) = zhongdian(1)
        zhongdian(0) = yuanxin(0) - r3
        zhongdian(1) = yuanxin(1)
        Set wesquxian = addarc1(yuanxin, qidian, zhongdian)
        Set templine = ThisDrawing.ModelSpace.AddLine(yuanxin, zhongdian)
        
        '添加半径引线R3
        banjingyinxian(0) = (yuanxin(0) + zhongdian(0)) / 2
        banjingyinxian(1) = (yuanxin(1) + zhongdian(1)) / 2
        banjingyinxian(2) = banjingyinxian(2)
        banjingyinxian(3) = banjingyinxian(3) + 0.4
        banjingyinxian(4) = banjingyinxian(2) - 0.35
        banjingyinxian(5) = banjingyinxian(3)
        ThisDrawing.ModelSpace.AddLightWeightPolyline (banjingyinxian)
        xydian(0) = banjingyinxian(4) + 0.03
        xydian(1) = banjingyinxian(5) + 0.03
        ThisDrawing.ModelSpace.AddText "R3", xydian, 0.2
        
         '添加标注B3
        dimpoint1(0) = basepoint(0)
        dimpoint1(1) = basepoint(1) + 0.8
        dimpoint2(0) = zhongdian(0)
        dimpoint2(1) = basepoint(1) + 0.8
        dimlocation(0) = dimpoint2(0)
        dimlocation(1) = (dimpoint1(1) + dimpoint2(1)) / 2 + 0.3
        Set biaozhuobj = ThisDrawing.ModelSpace.AddDimAligned(dimpoint1, dimpoint2, dimlocation)
        With biaozhuobj
                .ArrowheadSize = 0.06 * beishu '箭头的尺寸
                .TextHeight = 0.2 * beishu   '指定标注文字高度
                .ExtensionLineExtend = 0.1 * beishu '尺寸界线超出尺寸线的距离
                .ExtLineFixedLenSuppress = True '打开固定尺寸界线开关
                .ExtLineFixedLen = 0.1 * beishu '尺寸界线固定长度
                .TextOverride = "B3"
                .TextStyle = "wh_lkx"
                .scalefactor = 1
                .TextGap = 0 ' 放入标注文字时，标注文字与尺寸线之间的距离。
                '.TextPosition = dimlocation
        End With
        
         '添加标注Hd
        dimpoint1(0) = basepoint(0)
        dimpoint1(1) = basepoint(1)
        dimpoint2(0) = dimpoint1(0)
        dimpoint2(1) = dimpoint1(1) + hd
        dimlocation(0) = basepoint(0) - 1.3
        dimlocation(1) = (dimpoint1(1) + dimpoint2(1)) / 2
        Set biaozhuobj = ThisDrawing.ModelSpace.AddDimAligned(dimpoint1, dimpoint2, dimlocation)
        With biaozhuobj
                .ArrowheadSize = 0.06 * beishu '箭头的尺寸
                .TextHeight = 0.2 * beishu   '指定标注文字高度
                .ExtensionLineExtend = 0.1 * beishu '尺寸界线超出尺寸线的距离
                .ExtLineFixedLenSuppress = True '打开固定尺寸界线开关
                .ExtLineFixedLen = 0.1 * beishu '尺寸界线固定长度
                .TextOverride = "Hd"
                .TextStyle = "wh_lkx"
                .scalefactor = 1
                .TextRotation = 0.0001
                .TextGap = 0
        End With
               
        linshidian(0) = zhongdian(0) '画左边的竖线
        If hd >= 1 Then
                linshidian(1) = basepoint(1) - 6
        ElseIf hd >= 0.7 Then
                linshidian(1) = basepoint(1) - 10 * hd
        ElseIf hd >= 0.4 Then
                linshidian(1) = basepoint(1) - 25 * hd
        ElseIf hd > 0.2 Then
                linshidian(1) = basepoint(1) - 50 * hd
        Else
                linshidian(1) = basepoint(1) - 100 * hd
        End If
        ThisDrawing.ModelSpace.AddLine zhongdian, linshidian
        
        
        '下面绘制幂曲线 x 画到4m 81个坐标点 就差不多了
        'Dim miquxian As AcadLWPolyline
        Dim points(0 To 161) As Double
        Dim i As Double
        ' 定义二维多段线顶点，x值增量为0.05m,5cm
        x = 0
        For i = 0 To 80 Step 1
                y = x ^ n / k / hd ^ (n - 1)
                points(i * 2) = x + basepoint(0)
                points(i * 2 + 1) = -1 * y + basepoint(1)
                x = x + 0.05
        Next
        ThisDrawing.ModelSpace.AddLightWeightPolyline (points)
        
        '下面画坐标轴
        
        '画横轴
        Dim linelist(0 To 5) As Double
        linelist(0) = basepoint(0): linelist(1) = basepoint(1)
        linelist(2) = basepoint(0) + 3
        linelist(3) = basepoint(1)
        linelist(4) = basepoint(0) + 3.4: linelist(5) = basepoint(1)
        Dim jiantou As AcadLWPolyline
        Set jiantou = ThisDrawing.ModelSpace.AddLightWeightPolyline(linelist)
        jiantou.SetWidth 1, 0.1, 0
        jiantou.color = acRed
        xydian(0) = basepoint(0) + 3.5
        xydian(1) = basepoint(1)
        ThisDrawing.ModelSpace.AddText "x", xydian, 0.35
        
        '画竖轴
        linelist(0) = basepoint(0): linelist(1) = basepoint(1)
        linelist(2) = basepoint(0)
        linelist(3) = basepoint(1) - 3
        linelist(4) = basepoint(0): linelist(5) = basepoint(1) - 3.4
        Set jiantou = ThisDrawing.ModelSpace.AddLightWeightPolyline(linelist)
        jiantou.SetWidth 1, 0.1, 0
        jiantou.color = acRed
        xydian(0) = basepoint(0) + 0.2
        xydian(1) = basepoint(1) - 3.5
        ThisDrawing.ModelSpace.AddText "y", xydian, 0.35
        
        
        newtuxinggeshu = ThisDrawing.ModelSpace.count
        ' 放大剖面曲线
        For i = oldtuxinggeshu To newtuxinggeshu - 1
                ThisDrawing.ModelSpace.Item(i).ScaleEntity basepoint, beishu
        Next
        
        '下面插入幂曲线表格
        For i = 0 To 80 Step 1
                points(i * 2) = points(i * 2) - basepoint(0)
                points(i * 2 + 1) = points(i * 2 + 1) - basepoint(1)
        Next
        newtextstyle2    '调用新建字体样式程序
        ThisDrawing.SetVariable "textstyle", "wh_lkx"
        zigao = ComboBox1.Text
        basepoint = ThisDrawing.Utility.GetPoint(, "请拾取坐标表格插入点:")
        Dim biaotoukuan As Double '定义表格宽度
        Dim biaotougao As Double '定义表格高度
        If zigao < 4 Then
                biaotoukuan = 20
                biaotougao = 8
        Else
                biaotoukuan = zigao * 8
                biaotougao = zigao * 2.5
        End If
        Dim hengxian As AcadLWPolyline
        Dim p1p2(0 To 3) As Double
        p1p2(0) = basepoint(0): p1p2(1) = basepoint(1)
        p1p2(2) = basepoint(0) + 2 * biaotoukuan: p1p2(3) = p1p2(1)
        ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
        p1p2(0) = basepoint(0): p1p2(1) = basepoint(1) - biaotougao
        p1p2(2) = basepoint(0) + 2 * biaotoukuan: p1p2(3) = p1p2(1)
        ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
        
        
        
        '====================================
        '下面画表格
        For i = 0 To 40
                p1p2(0) = basepoint(0)
                p1p2(1) = p1p2(1) - biaotougao
                p1p2(2) = basepoint(0) + 2 * biaotoukuan
                p1p2(3) = p1p2(1)
                ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
        Next
        For i = 0 To 2
                p1p2(0) = basepoint(0) + biaotoukuan * i
                p1p2(1) = basepoint(1)
                p1p2(2) = p1p2(0)
                ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
        Next
        


        '下面插入数据
        Dim mingcheng As AcadText
        Dim charudian(0 To 2) As Double
        charudian(0) = basepoint(0) + biaotoukuan * 0.5
        charudian(1) = basepoint(1) - biaotougao * 0.5
        Set mingcheng = ThisDrawing.ModelSpace.AddText("x坐标(cm)", charudian, zigao)
        With mingcheng
                .Alignment = acAlignmentMiddleCenter
                .TextAlignmentPoint = charudian
        End With
        charudian(0) = basepoint(0) + biaotoukuan * 1.5
        charudian(1) = basepoint(1) - biaotougao * 0.5
        Set mingcheng = ThisDrawing.ModelSpace.AddText("y坐标(cm)", charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
            
        ' 重新定义二维多段线顶点，x值增量为0.1m,10cm
'        x = 0
'        For i = 0 To 40 Step 1
'                y = x ^ n / k / hd ^ (n - 1)
'                points(i * 2) = x
'                points(i * 2 + 1) = -1 * y
'                x = x + 0.1
'        Next
        '插入编号及x y  坐标
        x = 0
        For i = 1 To 41
                charudian(0) = basepoint(0) + biaotoukuan * 0.5
                charudian(1) = basepoint(1) - (i + 0.5) * biaotougao
                Set mingcheng = ThisDrawing.ModelSpace.AddText(x * 100, charudian, zigao)
                mingcheng.Alignment = acAlignmentMiddleCenter
                mingcheng.TextAlignmentPoint = charudian
               
                charudian(0) = basepoint(0) + biaotoukuan * 1.5
                charudian(1) = basepoint(1) - (i + 0.5) * biaotougao
                Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(x ^ n / k / hd ^ (n - 1) * 100, "0.0"), charudian, zigao)
                mingcheng.Alignment = acAlignmentMiddleCenter
                mingcheng.TextAlignmentPoint = charudian
                x = x + 0.1
        Next


        charudian(0) = basepoint(0)
        charudian(1) = basepoint(1) + biaotougao
        Dim mtextobj As AcadMText
        Dim textstring As String
        textstring = "幂曲线方程: x{\H0.5x;\S" & n & ";}=" & k & hd & "{\H0.5x;\S" & n - 1 & ";} y"
        Set mtextobj = ThisDrawing.ModelSpace.AddMText(charudian, 0, textstring)
        mtextobj.height = zigao
        
        '上游堰面曲线参数
        basepoint(0) = basepoint(0) + 3 * biaotoukuan
        basepoint(1) = basepoint(1)
        basepoint(2) = 0
        p1p2(1) = basepoint(1)
        '下面画表格
        For i = 0 To 3
                p1p2(0) = basepoint(0)
                p1p2(2) = basepoint(0) + 4 * biaotoukuan
                p1p2(3) = p1p2(1)
                ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
                p1p2(1) = p1p2(1) - biaotougao
        Next
        For i = 0 To 4
                p1p2(0) = basepoint(0) + biaotoukuan * i
                p1p2(1) = basepoint(1)
                p1p2(2) = p1p2(0)
                ThisDrawing.ModelSpace.AddLightWeightPolyline p1p2
        Next
        
        For i = 0 To 2
                charudian(0) = basepoint(0) + biaotoukuan * 0.5
                charudian(1) = basepoint(1) - (i + 0.5) * biaotougao
                Set mingcheng = ThisDrawing.ModelSpace.AddText("R" & i + 1, charudian, zigao)
                mingcheng.Alignment = acAlignmentMiddleCenter
                mingcheng.TextAlignmentPoint = charudian
               
                charudian(0) = basepoint(0) + biaotoukuan * 2.5
                charudian(1) = basepoint(1) - (i + 0.5) * biaotougao
                Set mingcheng = ThisDrawing.ModelSpace.AddText("B" & i + 1, charudian, zigao)
                mingcheng.Alignment = acAlignmentMiddleCenter
                mingcheng.TextAlignmentPoint = charudian
                x = x + 0.1
        Next
        
        charudian(0) = basepoint(0) + biaotoukuan * 1.5
        charudian(1) = basepoint(1) - 0.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(r1, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0) + biaotoukuan * 1.5
        charudian(1) = basepoint(1) - 1.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(r2, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0) + biaotoukuan * 1.5
        charudian(1) = basepoint(1) - 2.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(r3, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0) + biaotoukuan * 3.5
        charudian(1) = basepoint(1) - 0.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(0.175 * hd, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0) + biaotoukuan * 3.5
        charudian(1) = basepoint(1) - 1.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(0.276 * hd, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0) + biaotoukuan * 3.5
        charudian(1) = basepoint(1) - 2.5 * biaotougao
        Set mingcheng = ThisDrawing.ModelSpace.AddText(Format(0.2818 * hd, "0.000"), charudian, zigao)
        mingcheng.Alignment = acAlignmentMiddleCenter
        mingcheng.TextAlignmentPoint = charudian
        
        charudian(0) = basepoint(0)
        charudian(1) = basepoint(1) + biaotougao * 0.5
        Set mingcheng = ThisDrawing.ModelSpace.AddText("上游堰面曲线参数(单位:m)  By 沙漠骆驼(WHLKX)", charudian, zigao)


        Me.show
End Sub


Private Sub CommandButton2_Click()
        Me.Hide
End Sub


Private Sub TextBox1_Change()
        On Error Resume Next
        If Val(TextBox1.Text) <> TextBox1.Text Then
                TextBox1.Text = ""
                Exit Sub
        End If
        hd = TextBox1.Text
        r1 = 0.5 * hd
        r2 = 0.2 * hd
        r3 = 0.04 * hd
        Label5.Caption = Format(r1, "0.000")
        Label6.Caption = Format(r2, "0.000")
        Label8.Caption = Format(r3, "0.000")
End Sub


Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        Me.Hide
        Me.show vbModal
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        Me.Hide
        Me.show vbModal
End Sub
Private Sub TextBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
        Me.Hide
        Me.show vbModal
End Sub


Private Sub UserForm_Initialize()
        hd = TextBox1.Text
        r1 = 0.5 * hd
        r2 = 0.2 * hd
        r3 = 0.04 * hd
        Label5.Caption = Format(r1, "0.000")
        Label6.Caption = Format(r2, "0.000")
        Label8.Caption = Format(r3, "0.000")
        
        Dim i As Integer
        For i = 1 To 19  '设置字体高度
        ComboBox1.AddItem Format(i / 2 + 0.5, "0.0")
        Next
        For i = 15 To 95 Step 5  '15---95
            ComboBox1.AddItem i
        Next
        For i = 100 To 1000 Step 50 '100---500
            ComboBox1.AddItem i
        Next
        
        ComboBox2.AddItem 1 '设置放大系数
        ComboBox2.AddItem 10
        ComboBox2.AddItem 50
        ComboBox2.AddItem 100
        ComboBox2.AddItem 200
        ComboBox2.AddItem 500
        ComboBox2.AddItem 1000
End Sub