Spline应用一例

兰州人

程序如下

2. Sub lll()
3.    Dim R, R1, H, Dn, THK, Dn1, THK1
4.    Dim Alfa, baseAlfa
5.    Dim Pt1(2) As Double, Pt2(2) As Double
6.    
7.    Dim oLine As AcadLine
8.    Dim oDivide
9.    Dn = 2400: THK = 18
10.    Dn1 = 530: THK1 = 18
11.    R = Dn / 2 - THK
12.    Dim oCircle As AcadCircle
13.    'Set oCircle = ThisDrawing.ModelSpace.AddCircle(Pt1, R)
14.    'Debug.Print oCircle.Circumference;
15.    R1 = Dn1 / 2
16.    Set oCircle = ThisDrawing.ModelSpace.AddCircle(Pt1, R1)
17.    'Debug.Print oCircle.Circumference;
18.    H = 250
19.    Dim Pi
20.    Pi = Atn(1) * 4
21.    oDivide = 10
22.    Dim splinePt() As Double, oSpline As AcadSpline
23.    ReDim splinePt((360 / oDivide) * 3 + 2)
24.    baseAlfa = oDivide * Pi / 180
25.    Pt1(0) = 0
26.    Pt2(0) = 2 * R1 * Pi
27.    Set oLine = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)
28.    Dim StartTangent, EndTangent
29.    For n = 0 To 360 / oDivide
30.      Alfa = n * baseAlfa
31.      x = R1 * Cos(Alfa)
32.      Pt1(0) = n * R1 * baseAlfa
33.      Pt2(0) = Pt1(0)
34.      ln = H + (R - Sqr(R ^ 2 - x ^ 2))
35.      Pt2(0) = Pt1(0)
36.      Pt2(1) = ln
37.      'Debug.Print baseAlfa, Alfa, "x:" & Round(x, 5), "n=" & n, "Ln=" & ln
38.      If n = 0 Then
39.        StartTangent = Pt2
40.      End If
41.      Set oLine = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)
42.      For jj = 0 To 2
43.        splinePt(n * 3 + jj) = Pt2(jj)
44.      Next jj
45.    Next n
46.    EndTangent = Pt2
47.     Dim startTan(0 To 2) As Double
48.     Dim endTan(0 To 2) As Double
49.     'startTan(0) = 0: startTan(1) = 0.5: startTan(2) = 0
50.     'endTan(0) = 0.5: endTan(1) = -0.5: endTan(2) = 0
51.    Set oSpline = ThisDrawing.ModelSpace.AddSpline(splinePt, startTan, endTan)
52. End Sub

Sub lll()    Dim R, R1, H, Dn, THK, Dn1, THK1    Dim Alfa, baseAlfa    Dim Pt1(2) As Double, Pt2(2) As Double        Dim oLine As AcadLine    Dim oDivide    Dn = 2400: THK = 18    Dn1 = 530: THK1 = 18    R = Dn / 2 - THK    Dim oCircle As AcadCircle    'Set oCircle = ThisDrawing.ModelSpace.AddCircle(Pt1, R)    'Debug.Print oCircle.Circumference;    R1 = Dn1 / 2    Set oCircle = ThisDrawing.ModelSpace.AddCircle(Pt1, R1)    'Debug.Print oCircle.Circumference;    H = 250    Dim Pi    Pi = Atn(1) * 4    oDivide = 10    Dim splinePt() As Double, oSpline As AcadSpline    ReDim splinePt((360 / oDivide) * 3 + 2)    baseAlfa = oDivide * Pi / 180    Pt1(0) = 0    Pt2(0) = 2 * R1 * Pi    Set oLine = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)    Dim StartTangent, EndTangent    For n = 0 To 360 / oDivide      Alfa = n * baseAlfa      x = R1 * Cos(Alfa)      Pt1(0) = n * R1 * baseAlfa      Pt2(0) = Pt1(0)      ln = H + (R - Sqr(R ^ 2 - x ^ 2))      Pt2(0) = Pt1(0)      Pt2(1) = ln      'Debug.Print baseAlfa, Alfa, "x:" & Round(x, 5), "n=" & n, "Ln=" & ln      If n = 0 Then        StartTangent = Pt2      End If      Set oLine = ThisDrawing.ModelSpace.AddLine(Pt1, Pt2)      For jj = 0 To 2        splinePt(n * 3 + jj) = Pt2(jj)      Next jj    Next n    EndTangent = Pt2     Dim startTan(0 To 2) As Double     Dim endTan(0 To 2) As Double     'startTan(0) = 0: startTan(1) = 0.5: startTan(2) = 0     'endTan(0) = 0.5: endTan(1) = -0.5: endTan(2) = 0    Set oSpline = ThisDrawing.ModelSpace.AddSpline(splinePt, startTan, endTan) End Sub

等着

试了下，正确