【正文】 (傾斜曲線 ) = acBlue = layer3 Call qxqx Dim wn() As Double Dim wi() As Double Dim AQ() As Double Dim ds() As Double Dim gx() As Double Dim gy() As Double Dim n As Double Dim j As Integer n = Val() JX1 = Val() JY1 = Val() JX2 = Val() JY2 = Val() a = Atn((JY2 JY1) / (JX2 JX1)) Dim ss As String ss = Set fso = CreateObject() Set ttfile = (ss, 1) read = read = Replace(read, , ) 安徽理工大學(xué)畢業(yè)論文 21 Do While InStr(1, read, String(2, vbTab)) 0 read = Replace(read, String(2, vbTab), vbTab) Loop brr = 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 安徽理工大學(xué)畢業(yè)論文 22 AQ(3 * k) = (ds(k + 1) + ds(k)) / 2: AQ(3 * k + 1) = wi(k) / n + 20xx: AQ(3 * k + 2) = 0 mystr = mystr amp。 , amp。mystr = mystr amp。 , amp。 vbCrLf Next = mystr Dim splineObj As AcadSpline Dim startTan(0 To 2) As Double Dim endTan(0 To 2) As Double startTan(0) = 0: startTan(1) = 0: startTan(2) = 0 endTan(0) = 1500: endTan(1) = 0: endTan(2) = 0 安徽理工大學(xué)畢業(yè)論文 25 Set splineObj = (AQ, startTan, endTan) End Sub ： Private Sub CommandButton8_Click() Dim layer5 As AcadLayer Set layer5 = (水平移動(dòng)曲線 ) = acYellow = layer5 Call sp Dim ws() As Double Dim AQ() As Double Dim ds() As Double Dim hs() As Double Dim gx() As Double Dim gy() As Double Dim hx() As Double Dim hy() As Double Dim n As Double Dim k As Integer n = Val() JX1 = Val() JY1 = Val() JX2 = Val() JY2 = Val() a = Atn((JY2 JY1) / (JX2 JX1)) Dim ss As String ss = Set fso = CreateObject() 安徽理工大學(xué)畢業(yè)論文 26 Set ttfile = (ss, 1) read = read = Replace(read, , ) Do While InStr(1, read, String(2, vbTab)) 0 read = Replace(read, String(2, vbTab), vbTab) Loop 39。 AQ(3 * k + 1) amp。MsgBox read brr = Split(read, vbCrLf) ReDim ws(UBound(brr)) ReDim we(UBound(brr) 1) 安徽理工大學(xué)畢業(yè)論文 29 ReDim AQ(3 * UBound(brr) 1) ReDim ds(UBound(brr)) ReDim hs(UBound(brr)) ReDim gx(UBound(brr)) ReDim gy(UBound(brr)) ReDim hx(UBound(brr)) ReDim hy(UBound(brr)) ReDim ws(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) 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), ) hx(i) = Format(Sqr((CDbl(arr(4)) JX1) ^ 2 + (CDbl(arr(5)) JY1) ^ 2) * Cos(a) + JX1, ) hy(i) = Format(Sqr((CDbl(arr(4)) JX1) ^ 2 + (CDbl(arr(5)) JY1) ^ 2) * Sin(a) + JY1, ) hs(i) = Format(Sqr((hx(i) JX1) ^ 2 + (hy(i) JY1) ^ 2), ) ws(i) = hs(i) ds(i) End If End If Next For j = LBound(brr) To UBound(brr) 1 we(j) = (ws(j + 1) ws(j)) / (ds(j + 1) ds(j)) 39。 AQ(3 * k) amp。 AQ(3 * k + 2) amp。 AQ(3 * k + 1) amp。 wi(j) amp。 AQ(3 * k + 2) amp。 AQ(3 * k) amp。 , amp。 vbCrLf Next For m = LBound(brr) To UBound(brr) 3 wk(m) = 2 * (wi(m + 1) wi(m)) / (ds(m + 1) + ds(m)) Next For k = 0 To UBound(brr) 3 AQ(3 * k) = ds(k + 1): AQ(3 * k + 1) = wk(k) / n: AQ(3 * k + 2) = 0 mystr = mystr amp。 vbCrLf Next = mystr Dim splineObj As AcadSpline Dim startTan(0 To 2) As Double Dim endTan(0 To 2) As Double startTan(0) = 0: startTan(1) = 0: startTan(2) = 0 endTan(0) = 1500: endTan(1) = 0: endTan(2) = 0 Set splineObj = (AQ, startTan, endTan) End Sub ： Private Sub CommandButton7_Click() Dim layer4 As AcadLayer Set layer4 = (曲率曲線 ) = acGreen = layer4 Call qlqx Dim wn() As Double Dim wk() As Double Dim wi() As Double Dim AQ() As Double Dim ds() As Double Dim gx() As Double Dim gy() As Double Dim n As Double Dim j As Integer 安徽理工大學(xué)畢業(yè)論文 23 Dim m As Integer n = Val() JX1 = Val() JY1 = Val() JX2 = Val() JY2 = Val() a = Atn((JY2 JY1) / (JX2 JX1)) Dim ss As String ss = 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) Loop 39。 , amp。 , amp。MsgBox read brr = 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)) 安徽理工大學(xué)畢業(yè)論文 19 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。煤層走向推進(jìn)距離 ,開(kāi)切眼坐標(biāo)，基準(zhǔn)點(diǎn)坐標(biāo) ,開(kāi)切眼至基準(zhǔn)點(diǎn)距離 Dim plineObj As AcadLWPolyline Dim points(0 To 19) As Double HZ = Val() CH = Val() D = Val() j = Val() QBX = Val() QBY = Val(