根据浇注信息划分大坝模型程序设计

 

该程序能根据大坝浇注信息自动划分模型，根据具体的工程实例，如果要将大坝划分成600个模块，程序需要用约10分钟时间，人工划分需要花多少时间就无法计算了！呵呵！


浇注信息格式如下：
20430.00  20.39  08-12-01,0:00:00  2.27  08-12-03,6:32:04  15,16,17,18,  1194.50  1196.00

程序代码如下：



Imports System.IO
Imports System.Math

Public Class Form1
#Region "Define the paramenters"
    Public AcadApp As AutoCAD.AcadApplication
    Public MyallSelection As AutoCAD.AcadSelectionSet
    Public xx(), yy(), zz() As Double
    Public Count As Integer
    Public returnObj As Object
    Public textData(,) As String
    Public Structure DateTime
        Public dateYear As Integer
        Public dateMon As Integer
        Public dateDay As Integer
        Public dateHour As Integer
        Public dateMin As Integer
        Public dateSec As Integer
    End Structure
    Public startTime() As DateTime
    Public endTime() As DateTime
    Public startHeight(), endHeight() As Single
    Public damNum(,) As Boolean
    Public damHandle() As String
    Public damNumber As Integer
    Public IsNotDo01 As Boolean = False
    Public IsNotDo02 As Boolean = False
    Private Declare Auto Function SetProcessWorkingSetSize Lib "kernel32.dll" (ByVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As Boolean
    Public Sub SetProcessWorkingSetSize()   '节约系统内存
        Try
            Dim Mem As Process
            Mem = Process.GetCurrentProcess()
            SetProcessWorkingSetSize(Mem.Handle, -1, -1)
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Sub
#End Region
    Public Sub 启动CAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
        End If
        AcadApp.Visible = True
        AcadApp.WindowState = AutoCAD.AcWindowState.acMax
        AppActivate(AcadApp.Caption)
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Call SetProcessWorkingSetSize()
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        On Error GoTo Handle01
        Dim myOpen As OpenFileDialog = New OpenFileDialog()
        myOpen.Title = "导入浇注文本"
        myOpen.ShowDialog()
        Dim s As String = myOpen.FileName
        Dim s1 As String = ""

        Using sr As StreamReader = New StreamReader(s)
            Dim line As String
            Do
                line = sr.ReadLine()
                Count += 1
            Loop Until line Is Nothing
            sr.Close()
        End Using
        Count = Count - 1
        ReDim Preserve textData(Count, 8)
        Using sr1 As StreamReader = New StreamReader(s)
            Dim line As String
            Dim i As Integer
            For i = 0 To Count - 1
                line = sr1.ReadLine()
                ReadDate01(line, i)
            Next
            sr1.Close()
        End Using
        IsNotDo01 = True
        If (IsNotDo01 = True And IsNotDo02 = True) Then Button8.Enabled = True
        Exit Sub
handle01:
        MsgBox(Err.Description)
    End Sub
    Public Sub ReadDate01(ByVal textString As String, ByVal lineNum As Integer)
        Dim s1 As String = textString
        Dim i, j, startNum As Integer
        Dim c As Char
        startNum = 1
        For i = 1 To s1.Length
            c = Mid(s1, i, 1)
            If c = Chr(32) Then
                If j < 7 Then
                    textData(lineNum, j) = Mid(s1, startNum, i - startNum)
                    i = i + 1
                    startNum = i + 1
                    j += 1
                Else
                    Exit For
                End If
            End If
        Next
        textData(lineNum, 7) = Microsoft.VisualBasic.Mid(s1, startNum)
        '    MsgBox(textData(lineNum, 2))
    End Sub
    Public Sub ReadStartDateTime()
        ReDim Preserve startTime(Count)
        Dim s1 As String
        Dim i, j As Integer
        Dim c As Char
        j = 1
        For j = 0 To Count - 1
            s1 = textData(j, 2)
            startTime(j).dateYear = CInt((Mid(s1, 1, 2)))
            startTime(j).dateMon = CInt((Mid(s1, 4, 2)))
            startTime(j).dateDay = CInt((Mid(s1, 7, 2)))
            s1 = Microsoft.VisualBasic.Mid(s1, 10)
            For i = 1 To s1.Length
                c = Mid(s1, i, 1)
                If c = ":" Then
                    startTime(j).dateHour = CInt(Microsoft.VisualBasic.Left(s1, i - 1))
                    Exit For
                End If
            Next i
            startTime(j).dateMin = CInt((Mid(s1, i + 1, 2)))
            startTime(j).dateSec = CInt((Mid(s1, i + 4, 2)))
        Next j
    End Sub
    Public Sub ReadEndDateTime()
        ReDim Preserve endTime(Count)
        Dim s1 As String
        Dim i, j As Integer
        Dim c As Char
        j = 1
        For j = 0 To Count - 1
            s1 = textData(j, 4)
            endTime(j).dateYear = CInt((Mid(s1, 1, 2)))
            endTime(j).dateMon = CInt((Mid(s1, 4, 2)))
            endTime(j).dateDay = CInt((Mid(s1, 7, 2)))
            s1 = Microsoft.VisualBasic.Mid(s1, 10)
            For i = 1 To s1.Length
                c = Mid(s1, i, 1)
                If c = ":" Then
                    endTime(j).dateHour = CInt(Microsoft.VisualBasic.Left(s1, i - 1))
                    Exit For
                End If
            Next i
            endTime(j).dateMin = CInt((Mid(s1, i + 1, 2)))
            endTime(j).dateSec = CInt((Mid(s1, i + 4, 2)))
        Next j
    End Sub
    Public Sub ReadDamNum()
        ReDim Preserve damNum(Count, damNumber)   '假定有35个坝段
        Dim i, j, m As Integer
        Dim c As Char
        Dim s As String
        For i = 0 To Count - 1
            m = 1
            s = textData(i, 5)
            For j = 1 To s.Length
                c = Microsoft.VisualBasic.Mid(s, j, 1)
                If c = "," Then
                    damNum(i, CInt(Microsoft.VisualBasic.Mid(s, m, j - m))) = True   '从0行开始的,列以1开头
                    m = j + 1
                End If
            Next
        Next
    End Sub
    Public Sub GetHeight()
        Dim i As Integer
        ReDim Preserve startHeight(Count)
        ReDim Preserve endHeight(Count)
        For i = 0 To Count - 1
            startHeight(i) = CInt(textData(i, 6))
            endHeight(i) = CInt(textData(i, 7))
        Next
    End Sub
    Public Sub DoModel()
        MyallSelection = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet")
        MyallSelection.Select(AutoCAD.AcSelect.acSelectionSetAll)
        Dim i, j As Integer
        For i = 0 To Count - 1
            For j = 1 To damNumber
                If damNum(i, j) = True Then
                    Dim myobject As Object
                    Call FindDamHandle(j - 1, myobject)
                    CreateModel(myobject, CSng(textData(i, 6)), CSng(textData(i, 7)))
                End If
            Next j
        Next i

    End Sub
    Public Sub FindDamHandle(ByVal i As Integer, ByRef myobject As Object)
        Dim newdamhandle As String = damHandle(i)
        Dim object01 As Object
        For Each object01 In MyallSelection
            If object01.Objectname.ToString() = "AcDb3dSolid" And object01.Handle = newdamhandle Then
                myobject = object01
                Exit Sub
            End If
        Next
    End Sub
    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        On Error GoTo handle1
        Call 启动CAD()
        Dim basePnt As Object
        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)
        returnObj.highlight(True)
        AppActivate(AcadApp.Caption)
        Dim ss As AutoCAD.Acad3DSolid
        damNumber += 1
        ReDim Preserve damHandle(damNumber)
        damHandle(damNumber - 1) = returnObj.Handle
        MsgBox("获取对象的名称为：" + returnObj.objectname.ToString() + ",其Handle为：" + returnObj.Handle)
        AppActivate(Me.Text)
        Exit Sub
handle1:
        MsgBox(Err.Description)
    End Sub

    Public Sub CreateModel(ByVal myObject As Object, ByVal mystartheight As Single, ByVal myendheight As Single)
        On Error GoTo handle01
        If myObject.Objectname <> "AcDb3dSolid" Then Exit Sub
        Dim newobject01 As AutoCAD.Acad3DSolid
        Dim newobject02 As AutoCAD.Acad3DSolid
        Dim minpoints, maxpoints As Object
        newobject02 = myObject.Copy
        myObject.GetBoundingBox(minpoints, maxpoints)
        Dim origin(0 To 2) As Double   '新建的Box的中心
        origin(0) = minpoints(0) + (maxpoints(0) - minpoints(0)) / 2
        origin(1) = minpoints(1) + (maxpoints(1) - minpoints(1)) / 2
        origin(2) = mystartheight + (myendheight - mystartheight) / 2
        newobject01 = AcadApp.ActiveDocument.ModelSpace.AddBox(origin, Abs(minpoints(0) - maxpoints(0)), Abs(minpoints(1) - maxpoints(1)), myendheight - mystartheight)
        newobject01.Boolean(AutoCAD.AcBooleanType.acIntersection, newobject02)
        newobject01.Update()
        Exit Sub
handle01:
    End Sub
    Private Sub ReadDamHandleButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ReadDamHandleButton.Click
        On Error GoTo handle01
        Dim myOpen As OpenFileDialog = New OpenFileDialog()
        myOpen.Title = "导入坝段Handle文件"
        myOpen.ShowDialog()
        Dim s As String = myOpen.FileName
        Dim s1 As String = ""
        Using sr As StreamReader = New StreamReader(s)
            Dim line As String
            Do
                line = sr.ReadLine()
                ReDim Preserve damHandle(damNumber)
                damHandle(damNumber) = line
                damNumber += 1
            Loop Until line Is Nothing
            sr.Close()
        End Using
        damNumber = damNumber - 1
        IsNotDo02 = True
        If (IsNotDo01 = True And IsNotDo02 = True) Then Button8.Enabled = True
        Exit Sub
handle01:
        MsgBox(Err.Description)
    End Sub
    Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
        On Error GoTo Handle01
        Call 启动CAD()
        If CheckBox1.Checked = True Then AcadApp.ActiveDocument.SendCommand("_shademode" + vbCr + "F" + vbCr)
        Call ReadDamNum()
        Call DoModel()
        MsgBox("划分模型完成！")
        Call SetProcessWorkingSetSize()
        Exit Sub
handle01:
        MsgBox(Err.Description)
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        On Error GoTo handle01
        Dim dg As New OpenFileDialog
        dg.Filter = "CAD files (*.dwg)|*.dwg|All files (*.*)|*.*"
        dg.Title = "打开CAD文件"
        dg.ShowDialog()
        Dim s As String = dg.FileName
        If s = "" Then Exit Sub
        Call 启动CAD()
        AcadApp.Application.Documents.Open(s)
        AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMax
        AppActivate(Me.Text)
        Exit Sub
handle01:
        MsgBox(Err.Description)
    End Sub
End Class