另外，pi最好用Atn(1)*4代替 今天按照"正确的边界"还是做不出来,直线和轻便多义线都试过,为什么? st = 180 * 3.1415926 / 180<BR>ed = 360 * 3.1415926 / 180<BR>改成
st = Atn(1) * 4<BR>ed = Atn(1) * 8
我已经把我设计轴承时,自己设置的各点的位置标明在CAD图上,已经发到论坛上,请结合我设计的程序找出其中的错误,特别是为什么做不出剖面线. '图案填充
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的代码，测试用的。
页:
1
[2]