zlhcform.frm

计算力学特性曲线

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form ZLHCForm 
   Caption         =   "绘制力学曲线"
   ClientHeight    =   3015
   ClientLeft      =   5565
   ClientTop       =   4500
   ClientWidth     =   4635
   LinkTopic       =   "Form1"
   ScaleHeight     =   3015
   ScaleWidth      =   4635
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   315
      Top             =   3555
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton MBQXCmd 
      Caption         =   "绘制模板曲线"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   15
      TabIndex        =   5
      Top             =   2475
      Width           =   4575
   End
   Begin VB.CommandButton BMHCHCmd 
      Caption         =   "绘制架线表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   15
      TabIndex        =   4
      Top             =   1935
      Width           =   4575
   End
   Begin VB.CommandButton ZHLHCHCmd 
      Caption         =   "绘制力学特性曲线"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   15
      TabIndex        =   3
      Top             =   1395
      Width           =   4575
   End
   Begin VB.CommandButton EXITCmd 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   15
      TabIndex        =   2
      Top             =   840
      Width           =   4575
   End
   Begin VB.ListBox BList 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   690
      ItemData        =   "ZLHCForm.frx":0000
      Left            =   2115
      List            =   "ZLHCForm.frx":0002
      TabIndex        =   1
      Top             =   45
      Width           =   2475
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "请选择要制图的工作表名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   660
      Left            =   30
      TabIndex        =   0
      Top             =   45
      Width           =   1935
   End
End
Attribute VB_Name = "ZLHCForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Conductor As String
Public ConductorType As String
Public SagType As String

Dim Span() As Double
Dim ZLVolume() As Double
Dim HCVolume() As Double
Dim BMVolume() As Double
Dim TempDown As String
Dim Number As Long
Dim Number1 As Long
Dim PanDuan As Boolean
Dim PanDuan1 As String

Dim KVolume1() As Double
Dim KVolume2() As Double
Dim KVolume3() As Double
Public KMin As Double
Public KUnit As Double

Public ZLMin As Long
Public HCMin As Long
Public VAxis As Long
Public HAxis As Long
Public HCUnit As Long
Public ZLUnit As Long
Public DBMin As Long
Public DBUnit As Long
Public HDist As Double
Public VDist As Double
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long


Private Sub BList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim name2 As String
    On Error Resume Next
    '读取要绘制张力弧垂曲线的工作表名
        name2 = ZLHCForm.BList.List(BList.ListIndex)
        If name2 = "" Then
            ZLHCForm.BList.Selected(0) = True
            name2 = ZLHCForm.BList.List(BList.ListIndex)
        End If
        Set Excelsheet = Excelworkbook.Worksheets(name2)
    '读取电线种类、电压等级、电线型号
        Conductor = Excelsheet.Cells(1, 1)
        'Voltage = Excelsheet.Cells(2, 3)
        ConductorType = Excelsheet.Cells(1, 3)
        SagType = Excelsheet.Cells(196, 14)
                        
        ZLHCForm.ZHLHCHCmd.Caption = "绘制" & ConductorType & "的力学特性曲线"
        ZLHCForm.ZHLHCHCmd.Enabled = True
        If SagType = "1" Then
            ZLHCForm.BMHCHCmd.Caption = "绘制" & ConductorType & "的百米架线表"
        Else
            ZLHCForm.BMHCHCmd.Caption = "绘制" & ConductorType & "的架线表"
        End If
        ZLHCForm.BMHCHCmd.Enabled = True
        ZLHCForm.MBQXCmd.Caption = "绘制" & ConductorType & "的模板曲线"
        ZLHCForm.MBQXCmd.Enabled = True

End Sub

Private Sub BMHCHCmd_Click()
    ZLHCForm.BMHCHCmd.Enabled = False
    ZLHCForm.Hide
    DoEvents
    DangJuNumber
    DuQuBaiMiHuChui
    If SagType = "1" Then
        AcadDocs.Open "d:\vba\dwg\baimisag.dwg"
        Set AcadDoc = AcadApp.ActiveDocument
        Set MoSpace = AcadDoc.ModelSpace
    Else
        AcadDocs.Open "d:\vba\dwg\jiaxiansag.dwg"
        Set AcadDoc = AcadApp.ActiveDocument
        Set MoSpace = AcadDoc.ModelSpace
    End If
    
    HuiZhiBaiMiHuCHui
    AcadDoc.SendCommand "_saveas "
    ZLHCForm.Show

End Sub

Private Sub EXITCmd_Click()
    Unload ZLHCForm
    ExcelApp.Quit
    AcadApp.Quit
    Set ExcelApp = Nothing
    Set AcadApp = Nothing
End Sub

Private Sub Form_Load()
    Dim Noname As Long
    Dim i As Long
    Dim name2 As String
    Dim aaaa As Variant
    
    On Error Resume Next
    
    CommonDialog1.DialogTitle = "打开张力计算结果文件（*.xls）"
    CommonDialog1.InitDir = "d:\"
    CommonDialog1.Filter = "(*.xls)|*.xls"
    CommonDialog1.ShowOpen
    filename1 = ZLHCForm.CommonDialog1.FileName
    
    If filename1 = "" Then
        Unload ZLHCForm
        Exit Sub
    End If
        
    WinExec "C:\Program Files\ACAD2000\acad.exe", SW_SHOWMAXIMIZED
    DoEvents
    
    Set AcadApp = GetObject(, "autocad.application")
    If Err Then
        Err.Clear
        Set AcadApp = CreateObject("autocad.application")
        If Err Then
            MsgBox Err.Description
            Err.Clear
            Exit Sub
        End If
    End If
    AcadApp.Visible = True
    'AppActivate AcadApp.Caption
    AcadApp.WindowState = acMax
    'AcadApp.ZoomExtents
    Set AcadDocs = AcadApp.Documents
        
    Set ExcelApp = GetObject(, "excel.application")
    If Err Then
        Err.Clear
        Set ExcelApp = CreateObject("excel.application")
        If Err Then
            MsgBox Err.Description
            Err.Clear
            Exit Sub
        End If
    End If
        
    Set Excelworkbook = ExcelApp.Workbooks.Item(filename1)
    If Err Then
        Set Excelworkbook = ExcelApp.Workbooks.Open(filename1)
        Err.Clear
    End If
        
    Noname = Excelworkbook.Worksheets.Count
    For i = 1 To Noname
    name2 = Excelworkbook.Sheets.Item(i).Name
        If name2 <> "电线数据" And name2 <> "气象区" Then
            BList.AddItem name2
        End If
    Next
    
    ZHLHCHCmd.Enabled = False
    BMHCHCmd.Enabled = False
    MBQXCmd.Enabled = False
    
End Sub

Private Sub MBQXCmd_Click()
On Error GoTo ErrorHandler:

    AcadDocs.Add
    Set AcadDoc = AcadApp.ActiveDocument
    Set MoSpace = AcadDoc.ModelSpace
    ZLHCForm.MBQXCmd.Enabled = False
    ZLHCForm.Hide
    DoEvents
    DangJuNumber
    ZuoBiaoJiSuan2
    DuQuShuJu2
    HuiZhiZuoBiao2
    HuiZhiQuXian2
    HuiZhiTuKuang
    AcadDoc.Regen acAllViewports
    AcadApp.ZoomExtents
    AcadDoc.SendCommand "_saveas "
    ZLHCForm.Show
    
ErrorHandler:
    ZLHCForm.Show

End Sub

Private Sub ZHLHCHCmd_Click()
On Error GoTo ErrorHandler:

    ZLHCForm.ZHLHCHCmd.Enabled = False
    ZLHCForm.Hide
    DoEvents
    
    ZuoBiaoJiSuan
    DangJuNumber
    DuQuShuJu
    PanDuan = False

'********************以下为打开绘制模板文件部分***********************************
    AcadDocs.Open "d:\vba\dwg\quxian.dwg"
    Set AcadDoc = AcadApp.ActiveDocument
    Set MoSpace = AcadDoc.ModelSpace
'********************打开绘制模板文件部分结束*************************************
    
    HuiZhiZuoBiao
    HuiZhiQuXian
    TianXieShuJu

    AcadDoc.ActiveLayer = AcadDoc.Layers.Item("0")
    'AcadDoc.Regen acAllViewports
    'AcadApp.ZoomExtents

'********************以下为保存绘制好的文件部分************************************
        AcadDoc.SendCommand "_saveas "
'********************保存文件部分结束**********************************************

    If Conductor = "导线：" Then
        PanDuan = True
    Else
        PanDuan = False
    End If

    If PanDuan Then
        AcadDocs.Open "d:\vba\dwg\quxian1.dwg"
        Set AcadDoc = AcadApp.ActiveDocument
        Set MoSpace = AcadDoc.ModelSpace
        HuiZhiZuoBiao
        HuiZhiQuXian
        TianXieShuJu
        AcadDoc.ActiveLayer = AcadDoc.Layers.Item("0")
        'AcadDoc.Regen acAllViewports
        'AcadApp.ZoomExtents
        AcadDoc.SendCommand "_saveas "
    End If
    ZLHCForm.Show
    
ErrorHandler:
    ZLHCForm.Show

End Sub


'********************以下为确定坐标轴的间隔数、间隔单位、间隔距部分******************************
Sub ZuoBiaoJiSuan()
On Error Resume Next
    '读取要张力、弧垂、代表档距的最大和最小值
    Dim ZhangLiMax As Double, ZhangLiMin As Double
    Dim HuChuiMax As Double, HuChuiMin As Double
    Dim DBMax As Long
        ZhangLiMax = Excelsheet.Cells(60, 27): ZhangLiMin = Excelsheet.Cells(60, 28)
        HuChuiMax = Excelsheet.Cells(106, 27): HuChuiMin = Excelsheet.Cells(106, 28)
        DBMax = Excelsheet.Cells(61, 27): DBMin = Excelsheet.Cells(61, 28)
    If Err <> 0 Then
        MsgBox "张力或弧垂数据有错误！", vbOKOnly, "绘制力学特性曲线"
        Exit Sub
    End If

    '确定张力、弧垂轴的间隔单位
    Dim ZLMax As Long
    Dim HCMax As Long
    Dim ZLAxis As Long, HCAxis As Long
    '确定张力轴的间隔5千牛或者10千牛
    
        ZLMax = Int(ZhangLiMax / 1000 + 1): ZLMin = Int(ZhangLiMin / 1000)
        If ZLMax - ZLMin > 8 Then
            ZLMax = Int(ZhangLiMax / 2000 + 1): ZLMin = Int(ZhangLiMin / 2000)
            If ZLMax - ZLMin > 8 Then
                ZLMax = Int(ZhangLiMax / 5000 + 1): ZLMin = Int(ZhangLiMin / 5000)
                If ZLMax - ZLMin > 8 Then
                    ZLMax = Int(ZhangLiMax / 10000 + 1): ZLMin = Int(ZhangLiMin / 10000)
                    ZLUnit = 10000
                Else
                    ZLUnit = 5000
                End If
            Else
                ZLUnit = 2000
            End If
        Else
            ZLUnit = 1000
        End If
        ZLAxis = ZLMax - ZLMin
    '确定弧垂轴的间隔5米或者10米
        HCMax = Int(HuChuiMax / 2 + 1): HCMin = Int(HuChuiMin / 2)
        If HCMax - HCMin > 8 Then
            HCMax = Int(HuChuiMax / 5 + 1): HCMin = Int(HuChuiMin / 5)
            If HCMax - HCMin > 8 Then
                HCMax = Int(HuChuiMax / 10 + 1): HCMin = Int(HuChuiMin / 10)
                If HCMax - HCMin > 8 Then
                    HCMax = Int(HuChuiMax / 20 + 1): HCMin = Int(HuChuiMin / 20)
                    HCUnit = 20
                Else
                    HCUnit = 10
                End If
            Else
                HCUnit = 5
            End If
        Else
            HCUnit = 2
        End If
        HCAxis = HCMax - HCMin
    '确定水平轴的绘制间隔数目
        If DBMax - DBMin <= 200 Then
            If (DBMax - DBMin) Mod 25 = 0 Then
                HAxis = (DBMax - DBMin) / 25
                DBUnit = 25
            Else
                HAxis = Int((DBMax - DBMin) / 25) + 1
                DBUnit = 25
            End If
        End If
        
        If DBMax - DBMin > 500 Then
            If (DBMax - DBMin) Mod 100 = 0 Then
                HAxis = (DBMax - DBMin) / 100
            Else
                HAxis = Int((DBMax - DBMin) / 100) + 1
            End If
            DBUnit = 100
        ElseIf (DBMax - DBMin) Mod 50 = 0 Then
            HAxis = (DBMax - DBMin) / 50
            DBUnit = 50
        Else
            HAxis = Int(DBMax - DBMin / 50) + 1
            DBUnit = 50
        End If
    '确定垂直轴的绘制间隔数目
        If ZLAxis >= HCAxis Then
            VAxis = ZLAxis
        Else
            VAxis = HCAxis
        End If
    '确定张力坐标最小值
        ZLMax = Int(ZhangLiMax / ZLUnit) + 1
        ZLMin = ZLMax - VAxis
        If ZLMin < 0 Then
            ZLMin = 0
        End If
    '确定每个间隔的距离(毫米)
        HDist = 250 / HAxis: VDist = 200 / VAxis
End Sub