基于cad和vba地表移動(dòng)觀測(cè)站數(shù)據(jù)處理系統(tǒng)畢業(yè)論文(編輯修改稿)

　

【文章內(nèi)容簡(jiǎn)介】 CH, j 39。煤層中間點(diǎn)采深，平均采厚 39。煤層走向推進(jìn)距離,開切眼坐標(biāo)，基準(zhǔn)點(diǎn)坐標(biāo),開切眼至基準(zhǔn)點(diǎn)距離Dim plineObj As AcadLWPolylineDim points(0 To 19) As DoubleHZ = Val()CH = Val()D = Val()j = Val()QBX = Val()QBY = Val()JX1 = Val()JY1 = Val()39。沿走向Q = Sqr((QBX JX1) ^ 2 + (QBY JY1) ^ 2)points(0) = 0: points(1) = HZpoints(2) = 1000: points(3) = HZ + 1000 * Tan(j * / 180)points(4) = 1000: points(5) = HZ CH / Cos(j * / 180) + 1000 * Tan(j * / 180)points(6) = 0: points(7) = HZ CH / Cos(j * / 180)points(8) = 0: points(9) = HZpoints(10) = Q: points(11) = HZ + Q * Tan(j * / 180)points(12) = Q + D * Cos(j * / 180): points(13) = HZ + Q * Tan(j * / 180) + D * Sin(j * / 180)points(14) = Q + D * Cos(j * / 180): points(15) = HZ + Q * Tan(j * / 180) + D * Sin(j * / 180) CH / Cos(j * / 180)points(16) = Q: points(17) = HZ + Q * Tan(j * / 180) CH / Cos(j * / 180)points(18) = Q: points(19) = HZ + Q * Tan(j * / 180)Set plineObj = (points)ZoomAllEnd Sub煤層傾向采空區(qū)填充Public Sub QXTC()Dim HZ, D, QBX, QBY, JX1, JY1, Q, CH, j 39。煤層中間點(diǎn)采深，平均采厚 39。煤層走向推進(jìn)距離,開切眼坐標(biāo)，基準(zhǔn)點(diǎn)坐標(biāo),開切眼至基準(zhǔn)點(diǎn)距離Dim plineObj As AcadLWPolylineDim points(0 To 19) As DoubleHZ = Val()CH = Val()D = Val()j = Val()QBX = Val()QBY = Val()JX1 = Val()JY1 = Val()39。沿走向Q = Sqr((QBX JX1) ^ 2 + (QBY JY1) ^ 2)Dim solidObj As AcadSolidDim point1(0 To 2) As DoubleDim point2(0 To 2) As DoubleDim point3(0 To 2) As DoubleDim point4(0 To 2) As Double39。 定義實(shí)體point1(0) = Q: point1(1) = HZ + Q * Tan(j * / 180): point1(2) = 0point2(0) = Q + D * Cos(j * / 180): point2(1) = HZ + Q * Tan(j * / 180) + D * Sin(j * / 180): point2(2) = 0point4(0) = Q + D * Cos(j * / 180): point4(1) = HZ + Q * Tan(j * / 180) + D * Sin(j * / 180) CH / Cos(j * / 180): point4(2) = 0point3(0) = Q: point3(1) = HZ + Q * Tan(j * / 180) CH / Cos(j * / 180): point3(2) = 039。 在模型空間中創(chuàng)建實(shí)體對(duì)象Set solidObj = (point1, point2, point3, point4)ZoomAllEnd Sub3）曲線繪制代碼：Private Sub CommandButton5_Click()Dim layer1 As AcadLayerSet layer1 = (下沉曲線) = acRed = layer1Call ZSDim wn() As DoubleDim AQ() As DoubleDim ds() As DoubleDim gx() As DoubleDim gy() As DoubleDim n As Doublen = Val()JX1 = Val()JY1 = Val()JX2 = Val()JY2 = Val()a = Atn((JY2 JY1) / (JX2 JX1))Dim ss As Stringss = Set fso = CreateObject()Set ttfile = (ss, 1)read = read = Replace(read, , )Do While InStr(1, read, String(2, vbTab)) 0 read = Replace(read, String(2, vbTab), vbTab)Loop39。MsgBox readbrr = Split(read, vbCrLf)ReDim wn(UBound(brr))ReDim AQ(3 * UBound(brr) 1)ReDim ds(UBound(brr))ReDim gx(UBound(brr))ReDim gy(UBound(brr))For i = LBound(brr) To UBound(brr) If brr(i) Then arr = Split(brr(i), vbTab) If UBound(arr) 5 Then dn = arr(0) wn(i) = Format(CDbl(arr(6)) CDbl(arr(3)), ) gx(i) = Format(Sqr((CDbl(arr(1)) JX1) ^ 2 + (CDbl(arr(2)) JY1) ^ 2) * Cos(a) + JX1, ) gy(i) = Format(Sqr((CDbl(arr(1)) JX1) ^ 2 + (CDbl(arr(2)) JY1) ^ 2) * Sin(a) + JY1, ) ds(i) = Format(Sqr((gx(i) JX1) ^ 2 + (gy(i) JY1) ^ 2), ) mystr = mystr amp。 dn amp。 , amp。 ds(i) amp。 , amp。 wn(i) amp。 vbCrLf End If End If Next For k = LBound(brr) To UBound(brr) 1 AQ(3 * k) = ds(k): AQ(3 * k + 1) = wn(k) / n: AQ(3 * k + 2) = 0 Next = mystrDim splineObj As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoublestartTan(0) = 0: startTan(1) = 0: startTan(2) = 0endTan(0) = 1500: endTan(1) = 0: endTan(2) = 0Set splineObj = (AQ, startTan, endTan)End Sub：Private Sub CommandButton6_Click()Dim layer3 As AcadLayerSet layer3 = (傾斜曲線) = acBlue = layer3Call qxqxDim wn() As DoubleDim wi() As DoubleDim AQ() As DoubleDim ds() As DoubleDim gx() As DoubleDim gy() As DoubleDim n As DoubleDim j As Integern = Val()JX1 = Val()JY1 = Val()JX2 = Val()JY2 = Val()a = Atn((JY2 JY1) / (JX2 JX1))Dim ss As Stringss = Set fso = CreateObject()Set ttfile = (ss, 1)read = read = Replace(read, , )Do While InStr(1, read, String(2, vbTab)) 0 read = Replace(read, String(2, vbTab), vbTab)Loopbrr = Split(read, vbCrLf)ReDim wn(UBound(brr))ReDim AQ(3 * UBound(brr) 4)ReDim ds(UBound(brr))ReDim gx(UBound(brr))ReDim gy(UBound(brr))ReDim wi(UBound(brr) 1)For i = LBound(brr) To UBound(brr) If brr(i) Then arr = Split(brr(i), vbTab) If UBound(arr) 5 Then dn = arr(0) wn(i) = Format(CDbl(arr(6)) CDbl(arr(3)), ) gx(i) = Format(Sqr((CDbl(arr(1)) JX1) ^ 2 + (CDbl(arr(2)) JY1) ^ 2) * Cos(a) + JX1, ) gy(i) = Format(Sqr((CDbl(arr(1)) JX1) ^ 2 + (CDbl(arr(2)) JY1) ^ 2) * Sin(a) + JY1, ) ds(i) = Format(Sqr((gx(i) JX1) ^ 2 + (gy(i) JY1) ^ 2), ) End If End If Next For j = LBound(brr) To UBound(brr) 2 wi(j) = (wn(j + 1) wn(j)) / (ds(j + 1) ds(j)) Next For k = 0 To UBound(brr) 2 AQ(3 * k) = (ds(k + 1) + ds(k)) / 2: AQ(3 * k + 1) = wi(k) / n + 2000: AQ(3 * k + 2) = 0 mystr = mystr amp。 AQ(3 * k) amp。 , amp。 AQ(3 * k + 1) amp。 , amp。 AQ(3 * k + 2) amp。 vbCrLf Next = mystrDim splineObj As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoublestartTan(0) = 0: startTan(1) = 0: startTan(2) = 0endTan(0) = 1500: endTan(1) = 0: endTan(2) = 0Set splineObj = (AQ, startTan, endTan)End Sub：Private Sub CommandButton7_Click()Dim layer4 As AcadLayerSet layer4 = (曲率曲線) = acGreen = layer4Call qlqxDim wn() As DoubleDim wk() As DoubleDim wi() As DoubleDim AQ() As DoubleDim ds() As DoubleDim gx() As DoubleDim gy() As DoubleDim n As DoubleDim j As IntegerDim m As Integern = Val()JX1 = Val()JY1 = Val()JX2 = Val()JY2 = Val()a = Atn((JY2 JY1) / (JX2 JX1))Dim ss As Stringss = Set fso = CreateObject()Set ttfile =