轴承二次开发

sjsfsdrgy

那位高手帮助我解决剖面线问题，我用了很多方法（hatch)没有成功

雪山飞狐_lzh

你的轴承好像只有外边界，不需要内边界

雪山飞狐_lzh

把中间的弧和线一起连成Polyline，再做填充，InnerLoop（0）和InnerLoop（1）相交，当然不能创建内边界

sjsfsdrgy

你知道该怎么解决吗?

雪山飞狐_lzh

用圆弧和直线直接连接成内边界

sjsfsdrgy

我已经把圆弧和直线连到了一起作为外边界（我没用内边界），可还是没法填充啊。不知道为什么？

efan2000

是内边界有问题，内部的多段线与圆是相交的，不可能构成填充的内环。

雪山飞狐_lzh

把你的圆弧和直线连接的代码传上来看看

sjsfsdrgy

我设计边界时没有用圆，我只用圆弧和轻便多义线封闭，而且我的同学做他的设计时已经实现。我现在发一个自己任意做实验的程序。这个程序也出现同样的情况。 Private Sub Command1_Click()
On Error Resume Next
Set acadapp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox ("不能运行AUTOCAD, 请检查是否安装了AUTOCAD")
Exit Sub
End If
End If
acadapp.Visible = True '创建填充对象
Dim hatchobj As AcadHatch
Dim patternname As String
Dim patterntype As Long
Dim bassociativity As Boolean

'定义填充
patterntype = 0
patternname = "ANSI31"
bassociativity = True
'创建填充对象
Set hatchobj = acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, patternname, bassociativity) Dim outerloop(0 To 1) As AcadEntity
'Dim innerloop(0 To 0) As AcadEntity Dim points11(0 To 7) As Double
points11(0) = 30
points11(1) = 30
points11(2) = 30
points11(3) = 60
points11(4) = 60
points11(5) = 60
points11(6) = 60
points11(7) = 30
Set outerloop(0) = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points11) Dim cen(0 To 2) As Double
Dim r As Double
Dim startangle As Double
Dim endangle As Double
cen(0) = 45: cen(1) = 30: cen(2) = 0
r = 15
st = 180 * 3.1415926 / 180
ed = 360 * 3.1415926 / 180
Set outerloop(1) = acadapp.ActiveDocument.ModelSpace.AddArc(cen, r, st, ed)
'向填充对象添加填充边界
hatchobj.AppendOuterLoop (outerloop)
'hatchobj.AppendInnerLoop (innerloop)
hatchobj.Evaluate
acadapp.ActiveDocument.Regen True
ZoomExtents End Sub

雪山飞狐_lzh