[求助]：请问波浪线是怎么画出来的？

ahlzl

上贴中波浪线节点较多，文件较大。我又按XD老大在第5贴中的演示写了一个。用圆弧来来画波浪线，节点数较少。

2. [font=courier]
   
3. Sub blxARC()
   
4. 
   
5. Dim blxARC1, blxARC2 As AcadArc
   
6. Dim points() As Double
   
7. Dim a, n As Long
   
8. Dim R, H, L, c1, c2 As Double
   
9. Dim pa, pb As Variant
   
10. Dim po1(0 To 2) As Double
    
11. Dim po2(0 To 2) As Double
    
12. Const PI = 3.1415926535
    
13. 
    
14. pa = ThisDrawing.Utility.GetPoint(, "请输入波浪线起点：")
    
15. pb = ThisDrawing.Utility.GetPoint(pa, "请输入波浪线终点：")
    
16. n = ThisDrawing.Utility.GetReal("请输入波浪线周波数:")
    
17. H = ThisDrawing.Utility.GetDistance(pa, "请输入波浪线幅度：")
    
18. 
    
19. ReDim points(0 To 3 * n - 1) As Double
    
20. L = dis(pa, pb)
    
21. b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)
    
22. R = ((L * L / (16 * n * n) + H * H)) / (2 * H)
    
23. c1 = Atn(4 * n * (R - H) / L)
    
24. c2 = PI - c1
    
25. 
    
26. For a = 0 To 3 * n - 1 Step 3
    
27. points(a) = pa(0) + L / (4 * n) + L / (n) * a / 3
    
28. points(a + 1) = pa(1) + H - R
    
29. points(a + 2) = pa(2)
    
30. 
    
31. po1(0) = points(a)
    
32. po1(1) = points(a + 1)
    
33. po1(2) = points(a + 2)
    
34. po2(0) = points(a) + L / 2 / n
    
35. po2(1) = pa(1) - H + R
    
36. po2(2) = pa(2)
    
37. Set blxARC1 = ThisDrawing.ModelSpace.AddArc(po1, R, c1, c2)
    
38. Set blxARC2 = ThisDrawing.ModelSpace.AddArc(po2, R, PI + c1, PI + c2)
    
39. blxARC1.Rotate pa, b
    
40. blxARC2.Rotate pa, b
    
41. Next
    
42. 
    
43. ZoomExtents
    
44. End Sub
    
45. 
    
46. Public Function dis(pa, pb As Variant) As Double
    
47. dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2) ^ 0.5
    
48. End Function
    
49. [/font]
    

[font=courier]<br /> Sub blxARC()<br /> <br /> Dim blxARC1, blxARC2 As AcadArc<br /> Dim points() As Double<br /> Dim a, n As Long<br /> Dim R, H, L, c1, c2 As Double<br /> Dim pa, pb As Variant<br /> Dim po1(0 To 2) As Double<br /> Dim po2(0 To 2) As Double<br /> Const PI = 3.1415926535<br /> <br /> pa = ThisDrawing.Utility.GetPoint(, "请输入波浪线起点：")<br /> pb = ThisDrawing.Utility.GetPoint(pa, "请输入波浪线终点：")<br /> n = ThisDrawing.Utility.GetReal("请输入波浪线周波数:")<br /> H = ThisDrawing.Utility.GetDistance(pa, "请输入波浪线幅度：")<br /> <br /> ReDim points(0 To 3 * n - 1) As Double<br /> L = dis(pa, pb)<br /> b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)<br /> R = ((L * L / (16 * n * n) + H * H)) / (2 * H)<br /> c1 = Atn(4 * n * (R - H) / L)<br /> c2 = PI - c1<br /> <br /> For a = 0 To 3 * n - 1 Step 3<br /> points(a) = pa(0) + L / (4 * n) + L / (n) * a / 3<br /> points(a + 1) = pa(1) + H - R<br /> points(a + 2) = pa(2)<br /> <br /> po1(0) = points(a)<br /> po1(1) = points(a + 1)<br /> po1(2) = points(a + 2)<br /> po2(0) = points(a) + L / 2 / n<br /> po2(1) = pa(1) - H + R<br /> po2(2) = pa(2)<br /> Set blxARC1 = ThisDrawing.ModelSpace.AddArc(po1, R, c1, c2)<br /> Set blxARC2 = ThisDrawing.ModelSpace.AddArc(po2, R, PI + c1, PI + c2)<br /> blxARC1.Rotate pa, b<br /> blxARC2.Rotate pa, b<br /> Next<br /> <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 /> [/font]<br />

二者比较一下。

wharan

朋友们，别费这么大劲了，看我的一个线型，很简单解决问题。下载后直接解压到AutoCAD安装目录下的\support\目录下，加载线型，想怎么用就怎么用。方便吧？

vacancy

方便是方便，就是不能改圆弧的弧度，再问一下ahlzl ：你的程序怎么加载，为什么我存成dvb格式在2002中加载错误呢？

ahlzl

最初由 vacancy 发布
[B]方便是方便，就是不能改圆弧的弧度，再问一下ahlzl ：你的程序怎么加载，为什么我存成dvb格式在2002中加载错误呢？ [/B]

代码不能在记事本中粘贴，再存为dvb文件。
进入CAD的VBA编辑器，按F7进入代码窗口，粘贴，现在就可保存成dvb文件了。附件是作好的dvb文件。

vacancy

非常感谢！再提一个小建议：如果画好的线能自动连成一个pline就好了。

大水瓢

这是司马奇先生的lisp程序我一直在用，非常好用！！可试一试。

绘图员

工作中常用到,所以写了一个线型
把线型夹到acadios.lin中
把型定义夹到font文件夹中

kirinw

不知阁下是做什么工作的，可以说吗

lmm

可用spline命令

zzsong

真是高手云集啊。用了一下，呵，怎么在我这里却有问题。17贴，波浪线.zip，提示加载线形错误，21贴，司马奇先生的lisp，选择“2”后却变不成波浪线，其它两个没试。

zhiyongfan

斑竹奖励得好,我对VBA的认识从无到有了

jackie28

用样条曲线很简单

sprwind

完全随着鼠标运动而形成的，而且不用点击就能话出来。可以用于标注哪里是修改的地方

思语蝶

都是高手，厉害

zwjhuohu

编程这么厉害  问一下 用什么编的啊