【正文】 和n號點至 n1號點的水平距離。下沉盆地內兩點間單位長度的水平移動差稱之為水平變形，以ε表示，單位為 mm/m。3軟件實現 AutoCAD VBA簡介VBA ( visual basic for application) 是由Microsoft創(chuàng)建的，用來自動執(zhí)行任務的一個編程環(huán)境，它提供了一些用來創(chuàng)建圖形用戶界面的可拖拉工具和用來與AutoCAD對象交換的編程語言[5]。程序界面如圖2 。煤層信息有平均采深、采厚、傾角；采動信息有沿走向線上開切眼坐標、推進距離，沿傾向線上一邊界坐標、傾向寬度。計算觀測線方向代碼如下：39。首次和第m次觀測的平面坐標規(guī)劃實現代碼如下：39。 strtext amp。 Chr(10) Loop Close 1 End IfEnd Sub2）文件的導出代碼：Private Sub CommandButton2_Click() = 文本文件(*.txt)|*.txtIf Then Open For Output As 1 Print 1, Close 1End IfEnd Sub3)程序的退出代碼：Private Sub CommandButton4_Click()EndEnd Sub 計算移動和變形各點規(guī)劃至觀測線方向后，根據公式（23）~（26）計算出移動和變形。 曲線圖的繪制首先依原比例繪出煤層采動信息，及煤層與測點的空間關系。煤層中間點采深，平均采厚 39。沿走向SKQ = Sqr((KX JX1) ^ 2 + (KY JY1) ^ 2)points(0) = 0: points(1) = HZpoints(2) = 1000: points(3) = HZpoints(4) = 1000: points(5) = HZ CHpoints(6) = 0: points(7) = HZ CHpoints(8) = 0: points(9) = HZpoints(10) = SKQ: points(11) = HZpoints(12) = SKQ + ZD: points(13) = HZpoints(14) = SKQ + ZD: points(15) = HZ CHpoints(16) = SKQ: points(17) = HZ CHpoints(18) = SKQ: points(19) = HZSet plineObj = (points)ZoomAllEnd Sub煤層走向代碼如下：Public Sub CKQTC()Dim HZ, ZD, KX, KY, JX1, JY1, SKQ, CH 39。煤層走向推進距離,開切眼坐標，基準點坐標,開切眼至基準點距離 HZ = Val()CH = Val()ZD = Val()KX = Val()KY = Val()JX1 = Val()JY1 = Val()39。 定義實體point1(0) = SKQ: point1(1) = HZ CH: point1(2) = 0point2(0) = SKQ + ZD: point2(1) = HZ CH: point2(2) = 0point3(0) = SKQ: point3(1) = HZ: point3(2) = 0point4(0) = SKQ + ZD: point4(1) = HZ: point4(2) = 039。煤層中間點采深，平均采厚 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。煤層走向推進距離,開切眼坐標，基準點坐標,開切眼至基準點距離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。 定義實體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。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。 , amp。 , 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。 , amp。 , 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 = (