[VBA函数]：原创：正弦曲线

ahlzl

这是我第一次在这发贴！
本论坛中有一用LISP画正弦曲线的贴子，我编了两个VBA小程序，各位PP。

2. 
   
3. Sub sin1()
   
4. '由正弦曲线的起点、终点、幅度、周波数来画正弦曲线
   
5. Dim sinObj As AcadLWPolyline
   
6. Dim points() As Double
   
7. Dim a, n, k As Integer
   
8. Dim H, L As Double
   
9. Dim pa, pb As Variant
   
10. PI = 3.1415926535
    
11. 
    
12. pa = ThisDrawing.Utility.GetPoint(, "请输入正弦曲线起点：")
    
13. pb = ThisDrawing.Utility.GetPoint(pa, "请输入正弦曲线终点：")
    
14. H = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线幅度：")
    
15. n = ThisDrawing.Utility.GetReal("请输入正弦曲线周波数:")
    
16. k = ThisDrawing.Utility.GetReal("请输入正弦曲线每周波线段数（建议不小于36):")
    
17. 
    
18. ReDim points(0 To 2 * k * n + 1) As Double
    
19. L = dis(pa, pb)
    
20. b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)
    
21. 
    
22. For a = 0 To 2 * k * n Step 2
    
23. points(a) = pa(0) + L * (a / 2) / (k * n)
    
24. points(a + 1) = pa(1) + H * Sin(2 * PI * a / k / 2)
    
25. Next
    
26. 
    
27. Set sinObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    
28. sinObj.Rotate pa, b
    
29. ZoomExtents
    
30. End Sub
    
31. 
    
32. Public Function dis(pa, pb As Variant) As Double
    
33. dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2) ^ 0.5
    
34. End Function
    
35. 
    

<br /> Sub sin1()<br /> '由正弦曲线的起点、终点、幅度、周波数来画正弦曲线<br /> Dim sinObj As AcadLWPolyline<br /> Dim points() As Double<br /> Dim a, n, k As Integer<br /> Dim H, L As Double<br /> Dim pa, pb As Variant<br /> PI = 3.1415926535<br /> <br /> pa = ThisDrawing.Utility.GetPoint(, "请输入正弦曲线起点：")<br /> pb = ThisDrawing.Utility.GetPoint(pa, "请输入正弦曲线终点：")<br /> H = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线幅度：")<br /> n = ThisDrawing.Utility.GetReal("请输入正弦曲线周波数:")<br /> k = ThisDrawing.Utility.GetReal("请输入正弦曲线每周波线段数（建议不小于36):")<br /> <br /> ReDim points(0 To 2 * k * n + 1) As Double<br /> L = dis(pa, pb)<br /> b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)<br /> <br /> For a = 0 To 2 * k * n Step 2<br /> points(a) = pa(0) + L * (a / 2) / (k * n)<br /> points(a + 1) = pa(1) + H * Sin(2 * PI * a / k / 2)<br /> Next<br /> <br /> Set sinObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)<br /> sinObj.Rotate pa, b<br /> ZoomExtents<br /> End Sub<br /> <br /> Public Function dis(pa, pb As Variant) As Double<br /> dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2) ^ 0.5<br /> End Function<br /> <br />

2. 
   
3. Sub sin2()
   
4. '由正弦曲线的起点、幅度、周期、周波数、方向来画正弦曲线
   
5. Dim sinObj As AcadLWPolyline
   
6. Dim points() As Double
   
7. Dim a, n, k As Integer
   
8. Dim H, f As Double
   
9. Dim pa, pb As Variant
   
10. PI = 3.1415926535
    
11. 
    
12. pa = ThisDrawing.Utility.GetPoint(, "请输入正弦曲线起点：")
    
13. H = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线幅度：")
    
14. f = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线周期：")
    
15. n = ThisDrawing.Utility.GetReal("请输入正弦曲线周波数:")
    
16. k = ThisDrawing.Utility.GetReal("请输入正弦曲线每周波线段数（建议不小于36):")
    
17. pb = ThisDrawing.Utility.GetPoint(pa, "请输入点以确定正弦曲线的方向：")
    
18. 
    
19. ReDim points(0 To 2 * k * n + 1) As Double
    
20. b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)
    
21. 
    
22. For a = 0 To 2 * k * n Step 2
    
23. points(a) = pa(0) + f * (a / 2) / k
    
24. points(a + 1) = pa(1) + H * Sin(2 * PI * a / k / 2)
    
25. Next
    
26. 
    
27. Set sinObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    
28. sinObj.Rotate pa, b
    
29. ZoomExtents
    
30. End Sub
    

<br /> Sub sin2()<br /> '由正弦曲线的起点、幅度、周期、周波数、方向来画正弦曲线<br /> Dim sinObj As AcadLWPolyline<br /> Dim points() As Double<br /> Dim a, n, k As Integer<br /> Dim H, f As Double<br /> Dim pa, pb As Variant<br /> PI = 3.1415926535<br /> <br /> pa = ThisDrawing.Utility.GetPoint(, "请输入正弦曲线起点：")<br /> H = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线幅度：")<br /> f = ThisDrawing.Utility.GetDistance(pa, "请正弦曲线周期：")<br /> n = ThisDrawing.Utility.GetReal("请输入正弦曲线周波数:")<br /> k = ThisDrawing.Utility.GetReal("请输入正弦曲线每周波线段数（建议不小于36):")<br /> pb = ThisDrawing.Utility.GetPoint(pa, "请输入点以确定正弦曲线的方向：")<br /> <br /> ReDim points(0 To 2 * k * n + 1) As Double<br /> b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)<br /> <br /> For a = 0 To 2 * k * n Step 2<br /> points(a) = pa(0) + f * (a / 2) / k<br /> points(a + 1) = pa(1) + H * Sin(2 * PI * a / k / 2)<br /> Next<br /> <br /> Set sinObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)<br /> sinObj.Rotate pa, b<br /> ZoomExtents<br /> End Sub<br />