zlhcform.frm

计算力学特性曲线

    End If
    
    If Not (PanDuan) Then
        YanSe(0) = 3: YanSe(1) = 4: YanSe(2) = 6
        For k = dianxian To 2
            For j = 0 To LvNumber
            DjJg = LvXuHao(j + 1) - LvXuHao(j)
            ReDim QXPoint(3 * (DjJg + 1) - 1)
            
                For i = 0 To DjJg
                    QXPoint(3 * i) = (Span(i + LvXuHao(j)) - DBMin) * HDist / DBUnit
                    QXPoint(3 * i + 1) = (HCVolume(k, i + LvXuHao(j)) - HCMin * HCUnit) * VDist / HCUnit
                    QXPoint(3 * i + 2) = 0#
                Next
                Set QuXian = MoSpace.AddPolyline(QXPoint)
                With QuXian
                    .Color = YanSe(k)
                    .ConstantWidth = 0.5
                    .Update
                End With
                AcadDoc.SendCommand "_pedit L F  "
            Next
            
            BiaoZhu1(0) = QXPoint(3 * (DjJg + 1) - 3) - 5#
            BiaoZhu1(1) = QXPoint(3 * (DjJg + 1) - 2) + 5#
            BiaoZhu1(2) = QXPoint(3 * (DjJg + 1) - 1)
            BiaoZhu2(0) = QXPoint(3 * (DjJg + 1) - 3)
            BiaoZhu2(1) = QXPoint(3 * (DjJg + 1) - 2)
            BiaoZhu2(2) = QXPoint(3 * (DjJg + 1) - 3) - 3.2
            BiaoZhu2(3) = QXPoint(3 * (DjJg + 1) - 2) + 3.2
            Set Circle1 = MoSpace.AddCircle(BiaoZhu1, 2.5)
            Circle1.Color = YanSe(k)
            Circle1.Update
            Set BZText = MoSpace.AddText(BZHCtext(k), BiaoZhu1, 3)
            With BZText
                .Color = YanSe(k)
                .Alignment = acAlignmentMiddleCenter
                .TextAlignmentPoint = BiaoZhu1
                .ScaleFactor = 0.8
                .Update
            End With
            Set BZLine = MoSpace.AddLightWeightPolyline(BiaoZhu2)
            BZLine.Color = YanSe(k)
            BZLine.SetWidth 0, 0#, 0.5
            BZLine.Update
        Next
    End If
End Sub



'********************以下为填写相关参数部分****************************************
Sub TianXieShuJu()
    Dim TXPoint(2) As Double
    Dim shuju As String
    Dim TXText1 As AcadText
    Dim XWeizhi As Double
    Dim YWeizhi As Double
    Dim datalayer As AcadLayer
    
    On Error Resume Next
'填写电线参数
    AcadDoc.ActiveLayer = AcadDoc.Layers.Item("data")
    If Err <> 0 Then
        Set datalayer = AcadDoc.Layers.Add("data")
        AcadDoc.ActiveLayer = datalayer
        Err.Clear
    End If
    AcadDoc.ActiveLayer.Color = acWhite
    
    XWeizhi = 335#: YWeizhi = 189#: TXPoint(0) = XWeizhi: TXPoint(2) = 0#
        
    TXPoint(1) = YWeizhi
    shuju = Excelsheet.Cells(6, 10)
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
    With TXText1
        .Alignment = acAlignmentBottomRight
        .TextAlignmentPoint = TXPoint
        .ScaleFactor = 1
        .Update
    End With
    
    TXPoint(1) = YWeizhi - 5 * 1
    shuju = Excelsheet.Cells(6 + 1, 10)
    Set TXText1 = MoSpace.AddText(Format(shuju, "00.0E-"), TXPoint, 2.5)
    With TXText1
        .Alignment = acAlignmentBottomRight
        .TextAlignmentPoint = TXPoint
        .ScaleFactor = 1
        .Update
    End With
    
    TXPoint(1) = YWeizhi - 5 * 2
    shuju = Excelsheet.Cells(6 + 2, 10)
    Set TXText1 = MoSpace.AddText(Format(shuju, "0.0000"), TXPoint, 2.5)
    With TXText1
        .Alignment = acAlignmentBottomRight
        .TextAlignmentPoint = TXPoint
        .ScaleFactor = 1
        .Update
    End With
    
    For i = 3 To 5
        TXPoint(1) = YWeizhi - 5 * i
        shuju = Excelsheet.Cells(6 + i, 10)
        Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
        With TXText1
            .Alignment = acAlignmentBottomRight
            .TextAlignmentPoint = TXPoint
            .ScaleFactor = 1
            .Update
        End With
    Next
    
    '最大设计张力
    TXPoint(1) = YWeizhi - 5 * 6
    shuju = CStr(Int(Excelsheet.Cells(11, 10) / Excelsheet.Cells(12, 11) + 0.5))
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
    With TXText1
        .Alignment = acAlignmentBottomRight
        .TextAlignmentPoint = TXPoint
        .ScaleFactor = 1
        .Update
    End With
    
    '平均设计张力
    TXPoint(1) = YWeizhi - 5 * 7
    shuju = CStr(Int(Excelsheet.Cells(11, 10) * Excelsheet.Cells(13, 11) + 0.5))
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
    With TXText1
        .Alignment = acAlignmentBottomRight
        .TextAlignmentPoint = TXPoint
        .ScaleFactor = 1
        .Update
    End With

'填写气象条件
If Not (PanDuan) Then
    XWeizhi = 323#: YWeizhi = 44#
    For k = 0 To 2
        For i = 0 To 8
            shuju = Excelsheet.Cells(18 + i, 9 + k * 3)
            TXPoint(0) = XWeizhi + 11 * k: TXPoint(1) = YWeizhi - 5 * i: TXPoint(2) = 0#
            Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomRight
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
    Next
Else
    XWeizhi = 323#: YWeizhi = 64#
    For k = 0 To 2
        For i = 0 To 2
            shuju = Excelsheet.Cells(224 + i, 9 + k * 3)
            TXPoint(0) = XWeizhi + 11 * k: TXPoint(1) = YWeizhi - 5 * i: TXPoint(2) = 0#
            Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomRight
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
    Next
End If

'填写荷载
    XWeizhi = 318.5: YWeizhi = 124#: TXPoint(0) = XWeizhi: TXPoint(2) = 0#
    
    If Not (PanDuan) Then
        For i = 0 To 10
            shuju = Excelsheet.Cells(38 + i, 8)
            TXPoint(1) = YWeizhi - 5 * i
            Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomCenter
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
        
        XWeizhi = 345#: YWeizhi = 124#: TXPoint(0) = XWeizhi: TXPoint(2) = 0#
        For i = 0 To 10
            shuju = Excelsheet.Cells(38 + i, 12)
            TXPoint(1) = YWeizhi - 5 * i
            Set TXText1 = MoSpace.AddText(Format(shuju, "0.0000"), TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomRight
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
    End If

    If PanDuan Then
        For i = 0 To 6
            shuju = Excelsheet.Cells(230 + i, 8)
            TXPoint(1) = YWeizhi - 5 * i
            Set TXText1 = MoSpace.AddText(shuju, TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomCenter
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
        
        XWeizhi = 345#: TXPoint(0) = XWeizhi: TXPoint(2) = 0#
        For i = 0 To 6
            shuju = Excelsheet.Cells(230 + i, 12)
            TXPoint(1) = YWeizhi - 5 * i
            Set TXText1 = MoSpace.AddText(Format(shuju, "0.0000"), TXPoint, 2.5)
            With TXText1
                .Alignment = acAlignmentBottomRight
                .TextAlignmentPoint = TXPoint
                .ScaleFactor = 1
                .Update
            End With
        Next
    End If

'填写图名
If Not (PanDuan) Then
    If Conductor = "导线：" Then
        shuju = ConductorType & "导线力学特性曲线"
    Else
        shuju = ConductorType & "地线力学特性曲线"
    End If
    XWeizhi = 312.5358: YWeizhi = -38.9869: TXPoint(0) = XWeizhi: TXPoint(1) = YWeizhi: TXPoint(2) = 0#
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 5)
    With TXText1
        .Alignment = acAlignmentMiddleCenter
        .TextAlignmentPoint = TXPoint
        .StyleName = "tuming"
        .ScaleFactor = 0.8
        .Update
    End With
Else
    shuju = ConductorType & "导线力学特性曲线"
    XWeizhi = 312.5358: YWeizhi = -35.9869: TXPoint(0) = XWeizhi: TXPoint(1) = YWeizhi: TXPoint(2) = 0#
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 5)
    With TXText1
        .Alignment = acAlignmentMiddleCenter
        .TextAlignmentPoint = TXPoint
        .StyleName = "tuming"
        .ScaleFactor = 0.8
        .Update
    End With
    shuju = "(电气用)"
    XWeizhi = 312.5358: YWeizhi = -42.9869: TXPoint(0) = XWeizhi: TXPoint(1) = YWeizhi: TXPoint(2) = 0#
    Set TXText1 = MoSpace.AddText(shuju, TXPoint, 3.5)
    With TXText1
        .Alignment = acAlignmentMiddleCenter
        .TextAlignmentPoint = TXPoint
        .StyleName = "tuming"
        .ScaleFactor = 0.8
        .Update
    End With
End If
End Sub



'读取对应代表档距下的百米架线弧垂值
Sub DuQuBaiMiHuChui()
On Error Resume Next
    ReDim BMVolume(Number - 1, 9) As Double
    Dim i As Long, k As Long
    For k = 0 To Number - 1
        For i = 0 To 9
            BMVolume(k, i) = Excelsheet.Cells(200 + k, i * 2 + 2)
        Next
    Next
    TempDown = Excelsheet.Cells(197, 16)
    If Err <> 0 Then
        MsgBox "百米弧垂数据有错误！", vbOKOnly, "绘制架线表"
        Exit Sub
    End If

End Sub


'绘制百米架线弧垂表
Sub HuiZhiBaiMiHuCHui()
    Dim XWeizhi As Double
    Dim YWeizhi As Double
    Dim HPoint1(2) As Double
    Dim HPoint2(2) As Double
    Dim VPoint1(2) As Double
    Dim VPoint2(2) As Double
    Dim BMLine As AcadLine
    Dim BMText As AcadText
    Dim BMTxtPnt(2) As Double
    
    TempDown = Excelsheet.Cells(197, 16)
    For k = 0 To Number - 1
        BMTxtPnt(0) = 35#: BMTxtPnt(1) = 251.25 - k * 7.5: BMTxtPnt(2) = 0#
        If BMVolume(k, 0) > Int(BMVolume(k, 0)) Then
            Set BMText = MoSpace.AddText(Format(BMVolume(k, 0), "0.000"), BMTxtPnt, 2.5)
        Else
            Set BMText = MoSpace.AddText(BMVolume(k, 0), BMTxtPnt, 2.5)
        End If
        
        With BMText
            .Color = acWhite
            .Alignment = acAlignmentMiddleCenter
            .TextAlignmentPoint = BMTxtPnt
            .ScaleFactor = 1
            .StyleName = "standard"
            .Update
        End With
    Next
    
    XWeizhi = 45#: YWeizhi = 251.25
    For k = 0 To Number - 1
        For i = 1 To 9
            BMTxtPnt(0) = XWeizhi + i * 15# - 7.5: BMTxtPnt(1) = YWeizhi - k * 7.5: BMTxtPnt(2) = 0#
            Set BMText = MoSpace.AddText(Format(BMVolume(k, i), "0.0000"), BMTxtPnt, 2.5)
            With BMText
                .Color = acWhite
                .Alignment = acAlignmentMiddleCenter
                .TextAlignmentPoint = BMTxtPnt
                .StyleName = "standard"
            End With
            If SagType = "1" Then
                BMText.ScaleFactor = 1
            Else
                BMText.ScaleFactor = 0.85
            End If
            BMText.Update
        Next
    Next
    XWeizhi = 25#: YWeizhi = 255#
    For k = 0 To Number - 1
        HPoint1(0) = XWeizhi: HPoint1(1) = YWeizhi - (k + 1) * 7.5: HPoint1(2) = 0#
        HPoint2(0) = XWeizhi + 180#: HPoint2(1) = YWeizhi - (k + 1) * 7.5: HPoint2(2) = 0#
        Set BMLine = MoSpace.AddLine(HPoint1, HPoint2)
        With BMLine
            .Color = 252
            .Update
        End With
        For i = 0 To 9
            VPoint1(0) = 45# + i * 15#: VPoint1(1) = YWeizhi - k * 7.5: VPoint1(2) = 0#
            VPoint2(0) = 45# + i * 15#: VPoint2(1) = YWeizhi - (k + 1) * 7.5: VPoint2(2) = 0#
            Set BMLine = MoSpace.AddLine(VPoint1, VPoint2)
            With BMLine
                .Color = 252
                .Update
            End With
        Next
    Next
    BMTxtPnt(0) = 160#: BMTxtPnt(1) = 22.5: BMTxtPnt(2) = 0#
    If Conductor = "导线：" Then
        Set BMText = MoSpace.AddText(ConductorType & "导线架线表", BMTxtPnt, 6)
    Else
        Set BMText = MoSpace.AddText(ConductorType & "地线架线表", BMTxtPnt, 6)
    End If
    With BMText
        .Color = acWhite
        .Alignment = acAlignmentMiddleCenter
        .TextAlignmentPoint = BMTxtPnt
        .ScaleFactor = 0.8
        .StyleName = "tuming"
        .Update
    End With
    BMTxtPnt(0) = 102#: BMTxtPnt(1) = 73#: BMTxtPnt(2) = 0#
    Set BMText = MoSpace.AddText(Abs(Val(TempDown)) & "%%d" & "C", BMTxtPnt, 2.5)
    With BMText
        .Color = acRed
        .Alignment = acAlignmentBottomCenter
        .TextAlignmentPoint = BMTxtPnt
        .ScaleFactor = 0.8
        .StyleName = "standard"
        .Update
    End With
End Sub



'********************以下为确定坐标轴的间隔数、间隔单位、间隔距部分******************************
Sub ZuoBiaoJiSuan2()
On Error Resume Next
    Dim i As Long
    Dim PD() As String
    ReDim PD(Number - 1) As String
    PD(0) = Excelsheet.Cells(152, 26)
    For i = 1 To Number - 1
        PD(i) = Excelsheet.Cells(152 + i, 26)
        If PD(i - 1) = "GW" And PD(i) = "GW" Then
            PanDuan1 = "GW"
        ElseIf PD(i - 1) = "FB" And PD(i) = "FB" Then
            PanDuan1 = "FB"
        Else
            PanDuan1 = "TWO"
            Exit For
        End If
    Next
    
    '读取K值、代表档距的最大和最小值
    Dim KZhiMax As Double, KZhiMin As Double
    Dim DBMax As Long
        KZhiMax = Excelsheet.Cells(152, 27)
        If PanDuan1 = "GW" Then
            KZhiMin = Excelsheet.Cells(153, 28)
        ElseIf PanDuan1 = "FB" Then
            KZhiMin = Excelsheet.Cells(154, 28)
        Else
            KZhiMin = Excelsheet.Cells(152, 28)
        End If
        DBMax = Excelsheet.Cells(61, 27): DBMin = Excelsheet.Cells(61, 28)
    If Err <> 0 Then
        MsgBox "K值数据有错误！", vbOKOnly, "绘制模板曲线"
        Exit Sub
    End If

    '确定K值的绘制间隔数目、间隔单位
    Dim KZMax As Long, KZMin As Long
    KZhiMax = KZhiMax * 1000: KZhiMin = KZhiMin * 1000
    KZMax = Int(KZhiMax / 50) + 1: KZMin = Int(KZhiMin / 50)
    KUnit = 50 / 1000
 
    If (KZMin * KUnit + 0.005) > KZhiMin / 1000 Then
        KZMin = Int(KZhiMin / 50) - 1
    End If
    KMin = KZMin
    
    If KZMax - KZMin > 10 Then
    KZMax = Int(KZhiMax / 100) + 1: KZMin = Int(KZhiMin / 100)
    KUnit = 100 / 1000
        If (KZMin * KUnit + 0.015) > KZhiMin / 1000 Then
            KZMin = Int(KZhiMin / 100) - 1
        End If
        KMin = KZMin
    End If
    
    If KZMax - KZMin > 10 Then
    KZMax = Int(KZhiMax / 200) + 1: KZMin = Int(KZhiMin / 200)
    KUnit = 200 / 1000
        If (KZMin * KUnit + 0.025) > KZhiMin / 1000 Then
            KZMin = Int(KZhiMin / 200) - 1
        End If
        KMin = KZMin
    End If
    
    If KZMax - KZMin > 10 Then
    KZMax = Int(KZhiMax / 400) + 1: KZMin = Int(KZhiMin / 400)
    KUnit = 400 / 1000
        If (KZMin * KUnit + 0.045) > KZhiMin / 1000 Then
            KZMin = Int(KZhiMin / 400) - 1
        End If
        KMin = KZMin
    End If
    
    If KZMax - KZMin > 10 Then
    KZMax = Int(KZhiMax / 800) + 1: KZMin = Int(KZhiMin / 800)
    KUnit = 800 / 1000
        If (KZMin * KUnit + 0.085) > KZhiMin / 1000 Then
            KZMin = Int(KZhiMin / 800) - 1
        End If
        KMin = KZMin
    End If
    
    VAxis = KZMax - KZMin