自己写的画腰孔，感觉写的好繁琐，不知道该怎么改进

qwh923820

自学的CAD二次开发，写程序感觉好繁琐，不知道怎么进步，求指导。
下面是我写的用来调用画腰孔的程序，该怎么简化？？

1. Sub 画腰孔(ByVal p, ByVal r, ByVal jd, ByVal L, ByRef x, ByRef i)
   
2. 'p是要插入的腰孔中心点，r是腰孔半径，jd是腰孔的角度，L是腰孔直线的长度，x是存放图形的数组，i是记录图形存放在数组中的位置
   
3. Dim pt1(2) As Double, pt2(2) As Double, pt3(2) As Double, pt4(2) As Double
   
4. 
   
5. If jd = 0 Then
   
6. pt1(0) = p(0) - L / 2
   
7. pt1(1) = p(1) - r
   
8. pt1(2) = 0
   
9. 
   
10. pt2(0) = p(0) + L / 2
    
11. pt2(1) = p(1) - r
    
12. pt2(2) = 0
    
13. 
    
14. pt3(0) = p(0) - L / 2
    
15. pt3(1) = p(1) + r
    
16. pt3(2) = 0
    
17. 
    
18. pt4(0) = p(0) + L / 2
    
19. pt4(1) = p(1) + r
    
20. pt4(2) = 0
    
21. 
    
22. i = i + 1
    
23. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
24. i = i + 1
    
25. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)
    
26. 
    
27. pt1(1) = p(1)
    
28. i = i + 1
    
29. Set x(i) = ThisDrawing.ModelSpace.AddArc(pt1, r, 3.1415926535898 / 2, 3.1415926535898 * 1.5)
    
30. pt2(1) = p(1)
    
31. i = i + 1
    
32. Set x(i) = ThisDrawing.ModelSpace.AddArc(pt2, r, 3.1415926535898 * 1.5, 3.1415926535898 / 2)
    
33. 
    
34. pt1(0) = p(0) - L / 2 - r * 1.5
    
35. pt2(0) = p(0) + L / 2 + r * 1.5
    
36. i = i + 1
    
37. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
38. x(i).Linetype = "center"
    
39. x(i).Color = acRed
    
40. 
    
41. pt1(0) = p(0)
    
42. pt1(1) = p(1) + r * 1.5
    
43. pt2(0) = p(0)
    
44. pt2(1) = p(1) - r * 1.5
    
45. i = i + 1
    
46. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
47. x(i).Linetype = "center"
    
48. x(i).Color = acRed
    
49. Else
    
50.     pt1(0) = p(0) - r
    
51.     pt1(1) = p(1) - L / 2
    
52.     pt1(2) = 0
    
53. 
    
54.     pt2(0) = p(0) - r
    
55.     pt2(1) = p(1) + L / 2
    
56.     pt2(2) = 0
    
57. 
    
58.     pt3(0) = p(0) + r
    
59.     pt3(1) = p(1) + L / 2
    
60.     pt3(2) = 0
    
61. 
    
62.     pt4(0) = p(0) + r
    
63.     pt4(1) = p(1) - L / 2
    
64.     pt4(2) = 0
    
65. 
    
66. i = i + 1
    
67. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
68. i = i + 1
    
69. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)
    
70. 
    
71.     pt1(0) = p(0)
    
72.     i = i + 1
    
73. Set x(i) = ThisDrawing.ModelSpace.AddArc(pt1, r, 3.1415926535898, 0)
    
74. pt2(0) = p(0)
    
75. i = i + 1
    
76. Set x(i) = ThisDrawing.ModelSpace.AddArc(pt2, r, 0, 3.1415926535898)
    
77. 
    
78. pt1(1) = p(1) - L / 2 - r * 1.5
    
79. pt2(1) = p(1) + L / 2 + r * 1.5
    
80. i = i + 1
    
81. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
82. x(i).Linetype = "center"
    
83. x(i).Color = acRed
    
84. 
    
85. pt1(0) = p(0) + r * 1.5
    
86. pt1(1) = p(1)
    
87. pt2(0) = p(0) - r * 1.5
    
88. pt2(1) = p(1)
    
89. i = i + 1
    
90. Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
    
91. x(i).Linetype = "center"
    
92. x(i).Color = acRed
    
93. 
    
94. 
    
95. End If
    
96. 
    
97. End Sub

Sub 画腰孔(ByVal p, ByVal r, ByVal jd, ByVal L, ByRef x, ByRef i)<br /> 'p是要插入的腰孔中心点，r是腰孔半径，jd是腰孔的角度，L是腰孔直线的长度，x是存放图形的数组，i是记录图形存放在数组中的位置<br /> Dim pt1(2) As Double, pt2(2) As Double, pt3(2) As Double, pt4(2) As Double<br /> <br /> If jd = 0 Then<br /> pt1(0) = p(0) - L / 2<br /> pt1(1) = p(1) - r<br /> pt1(2) = 0<br /> <br /> pt2(0) = p(0) + L / 2<br /> pt2(1) = p(1) - r<br /> pt2(2) = 0<br /> <br /> pt3(0) = p(0) - L / 2<br /> pt3(1) = p(1) + r<br /> pt3(2) = 0<br /> <br /> pt4(0) = p(0) + L / 2<br /> pt4(1) = p(1) + r<br /> pt4(2) = 0<br /> <br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)<br /> <br /> pt1(1) = p(1)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddArc(pt1, r, 3.1415926535898 / 2, 3.1415926535898 * 1.5)<br /> pt2(1) = p(1)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddArc(pt2, r, 3.1415926535898 * 1.5, 3.1415926535898 / 2)<br /> <br /> pt1(0) = p(0) - L / 2 - r * 1.5<br /> pt2(0) = p(0) + L / 2 + r * 1.5<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> x(i).Linetype = "center"<br /> x(i).Color = acRed<br /> <br /> pt1(0) = p(0)<br /> pt1(1) = p(1) + r * 1.5<br /> pt2(0) = p(0)<br /> pt2(1) = p(1) - r * 1.5<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> x(i).Linetype = "center"<br /> x(i).Color = acRed<br /> Else<br />     pt1(0) = p(0) - r<br />     pt1(1) = p(1) - L / 2<br />     pt1(2) = 0<br /> <br />     pt2(0) = p(0) - r<br />     pt2(1) = p(1) + L / 2<br />     pt2(2) = 0<br /> <br />     pt3(0) = p(0) + r<br />     pt3(1) = p(1) + L / 2<br />     pt3(2) = 0<br /> <br />     pt4(0) = p(0) + r<br />     pt4(1) = p(1) - L / 2<br />     pt4(2) = 0<br /> <br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)<br /> <br />     pt1(0) = p(0)<br />     i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddArc(pt1, r, 3.1415926535898, 0)<br /> pt2(0) = p(0)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddArc(pt2, r, 0, 3.1415926535898)<br /> <br /> pt1(1) = p(1) - L / 2 - r * 1.5<br /> pt2(1) = p(1) + L / 2 + r * 1.5<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> x(i).Linetype = "center"<br /> x(i).Color = acRed<br /> <br /> pt1(0) = p(0) + r * 1.5<br /> pt1(1) = p(1)<br /> pt2(0) = p(0) - r * 1.5<br /> pt2(1) = p(1)<br /> i = i + 1<br /> Set x(i) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br /> x(i).Linetype = "center"<br /> x(i).Color = acRed<br /> <br /> <br /> End If<br /> <br /> End Sub

zzyong00

不明白你说的腰孔是什么东西，但有些坐标点计算，应该可以用AcadUtility 类的函数计算

qwh923820

zzyong00 发表于 2018-7-13 10:53
不明白你说的腰孔是什么东西，但有些坐标点计算，应该可以用AcadUtility 类的函数计算

就是这样的孔，我们这边叫腰孔。AcadUtility里面我是没找到直接的函数。我准备再写个倒角的函数，感觉倒角编起来很麻烦，不知道有没有现成的函数。

fatty0724

画出矩形 设置 2条边的凸度  

fatty0724

让用户点选两点 ，设置宽度     程序画矩形  设置2边凸度

Leo1980

一个polyline足矣