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

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


浇注信息格式如下：
20430.0020.3908-12-01,0:00:002.2708-12-03,6:32:0415,16,17,18,1194.501196.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
<!--v:3.2-->

<!--E 文章--><!--S 翻页-->