轴承二次开发

雪山飞狐_lzh

边界必须是首尾相连的


另外，pi最好用Atn(1)*4代替

sjsfsdrgy

今天按照"正确的边界"还是做不出来,直线和轻便多义线都试过,为什么?

雪山飞狐_lzh

st = 180 * 3.1415926 / 180
ed = 360 * 3.1415926 / 180
改成 st = Atn(1) * 4
ed = Atn(1) * 8

sjsfsdrgy

我已经把我设计轴承时,自己设置的各点的位置标明在CAD图上,已经发到论坛上,请结合我设计的程序找出其中的错误,特别是为什么做不出剖面线.

efan2000

2. '图案填充
3. Dim hatchObj As AcadHatch
4. Dim patternName As String
5. Dim PatternType As Long
6. Dim bAssociativity As Boolean
7. Dim b As Double
8. PatternType = 0
9. patternName = "ANSI31"
10. bAssociativity = True   '填充图案与边界相关联
11. '创建填充对象
12. Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
13. '创建填充边界
14. Dim OuterLoop(0 To 0) As AcadEntity Dim points1(0 To 11) As Double
15. points1(0) = ax0: points1(1) = ay0
16. points1(2) = ax1: points1(3) = ay1
17. points1(4) = ax2: points1(5) = ay2
18. points1(6) = ax13: points1(7) = ay13
19. points1(8) = ax12: points1(9) = ay12
20. points1(10) = ax11: points1(11) = ay11
21. Set OuterLoop(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(points1) '上填充区域' 计算凸度
22. b = Sqr((ax12 - ax13) ^ 2 + (ay12 - ay13) ^ 2) / 2
23. b = (r - Sqr(((ax12 + ax13) / 2 - yx1) ^ 2 + ((ay12 + ay13) / 2 - yx2) ^ 2)) / b
24. OuterLoop(0).SetBulge 3, b '设置凸度
25. OuterLoop(0).Closed = True '闭合'向填充对象添加填充边界
26. hatchObj.AppendOuterLoop (OuterLoop)
27. '用Evaluate方法进行求值，并显示填充
28. hatchObj.Evaluate
29. hatchObj.Color = acGreen
30. ThisDrawing.Regen TrueSet hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
31. hatchObj.PatternAngle = 3.14159 / 2 '填充角度
32. points1(0) = ax9: points1(1) = ay9
33. points1(2) = ax4: points1(3) = ay4
34. points1(4) = ax3: points1(5) = ay3
35. points1(6) = ax15: points1(7) = ay15
36. points1(8) = ax14: points1(9) = ay14
37. points1(10) = ax10: points1(11) = ay10
38. Set OuterLoop(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(points1) '下填充区域
39. OuterLoop(0).SetBulge 3, -b
40. OuterLoop(0).Closed = True
41. '向填充对象添加填充边界
42. hatchObj.AppendOuterLoop (OuterLoop)
43. '用Evaluate方法进行求值，并显示填充
44. hatchObj.Evaluate
45. hatchObj.Color = acGreen
46. ThisDrawing.Regen True

'图案填充 Dim hatchObj As AcadHatch Dim patternName As String Dim PatternType As Long Dim bAssociativity As Boolean Dim b As Double PatternType = 0 patternName = "ANSI31" bAssociativity = True   '填充图案与边界相关联 '创建填充对象 Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) '创建填充边界 Dim OuterLoop(0 To 0) As AcadEntity Dim points1(0 To 11) As Double points1(0) = ax0: points1(1) = ay0 points1(2) = ax1: points1(3) = ay1 points1(4) = ax2: points1(5) = ay2 points1(6) = ax13: points1(7) = ay13 points1(8) = ax12: points1(9) = ay12 points1(10) = ax11: points1(11) = ay11 Set OuterLoop(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(points1) '上填充区域' 计算凸度 b = Sqr((ax12 - ax13) ^ 2 + (ay12 - ay13) ^ 2) / 2 b = (r - Sqr(((ax12 + ax13) / 2 - yx1) ^ 2 + ((ay12 + ay13) / 2 - yx2) ^ 2)) / b OuterLoop(0).SetBulge 3, b '设置凸度 OuterLoop(0).Closed = True '闭合'向填充对象添加填充边界 hatchObj.AppendOuterLoop (OuterLoop) '用Evaluate方法进行求值，并显示填充 hatchObj.Evaluate hatchObj.Color = acGreen ThisDrawing.Regen TrueSet hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) hatchObj.PatternAngle = 3.14159 / 2 '填充角度 points1(0) = ax9: points1(1) = ay9 points1(2) = ax4: points1(3) = ay4 points1(4) = ax3: points1(5) = ay3 points1(6) = ax15: points1(7) = ay15 points1(8) = ax14: points1(9) = ay14 points1(10) = ax10: points1(11) = ay10 Set OuterLoop(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(points1) '下填充区域 OuterLoop(0).SetBulge 3, -b OuterLoop(0).Closed = True '向填充对象添加填充边界 hatchObj.AppendOuterLoop (OuterLoop) '用Evaluate方法进行求值，并显示填充 hatchObj.Evaluate hatchObj.Color = acGreen ThisDrawing.Regen True

原程序的填充区域是错误的，没有理解ACAD的规则，这是填充部分改写的代码。由于机器上没有安装VB，附件是VBA的代码，测试用的。