|
|
Sub 拟合求视速度1()
Dim n As Integer, vp As Integer, i As Integer, k As Integer
Dim x(1 To 2000) As Double
Dim y(1 To 2000) As Double
Dim da As Double, db As Double, a00 As Double, a01 As Double, a10 As Double
Dim a11 As Double, c0 As Double, c1 As Double, f0 As Double, fn As Double, height As Double
Dim lineObj As AcadLine
Dim textString As String
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim sset As AcadSelectionSet
Dim pline As AcadLWPolyline
ThisDrawing.Utility.Prompt "请选择要拟合的曲线："
Set sset = ThisDrawing.SelectionSets.Add("SS1")
sset.SelectOnScreen
Set pline = sset.Item(0)
Dim retCoord As Variant
retCoord = pline.Coordinates
pline.Delete
i = 1
k = 0
Do While i x(i) = retCoord(k)
y(i) = retCoord(k + 1)
i = i + 1
k = k + 3
Loop
n = 24
a00 = n
a01 = 0#
For i = 1 To n
a01 = a01 + x(i)
Next
a10 = a01
a11 = 0
For i = 1 To n
a11 = a11 + x(i) * x(i)
Next
c0 = 0
For i = 1 To n
c0 = c0 + y(i)
Next
c1 = 0
For i = 1 To n
c1 = c1 + x(i) * y(i)
Next
db = (c0 * a10 - c1 * a00) / (a01 * a10 - a00 * a11)
da = (c0 * a11 - c1 * a01) / (a11 * a00 - a01 * a10)
f0 = da + db * x(1)
fn = da + db * x(n)
startPoint(0) = x(1): startPoint(1) = f0: startPoint(2) = 0#
endPoint(0) = x(n): endPoint(1) = fn: endPoint(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
height = 4
vp = 1000 / db
textString = "vp" & "=" & vp
Set blockObj = ThisDrawing.ModelSpace.AddText(textString, endPoint, height)
End Sub
在给x(i),y(i)赋值时可能“Coordinates”属性搞错了，请各位师父改一下！ |
|
置顶卡
