兰州人 发表于 2009-9-29 12:01:00

Spline应用一例



程序如下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


等着 发表于 2009-10-24 14:46:00

试了下,正确
页: [1]
查看完整版本: Spline应用一例