一个关于充填的问题

陈琳

我用VB编写的程序，想后成上传文件中的一张图，但为什么不能充填(VB已经连接CAD准备开始绘图)，源码如下请各们帮我看一下要怎么修改才行，谢谢了：

Private Sub Command1_Click()

A=2:B=1

Set plineObj = Acadapp.ActiveDocument.ModelSpace.AddLine(inpnt1, inpnt2) '右边的线
Dim hatchObj As AcadHatch, patternName As String, PatternType As Long
Dim bAssociativity As Boolean, inloop(0 To 4) As AcadEntity
patternName = "SOLID"
PatternType = 0
bAssociativity = False

Set hatchObj = Acadapp.ActiveDocument.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
' 为阴影创建外部边界
p2(0) = 0: p2(1) = 0
Set inloop(0) = Acadapp.ActiveDocument.ModelSpace.AddLine(p2, inpnt)
p1(0) = A / 2 - B / 6 * Cos(PI / 4): p1(1) = -B / 2 - B / 6 * Sin(PI / 4)
Set inloop(1) = Acadapp.ActiveDocument.ModelSpace.AddLine(inpnt, p1)
p1(0) = A / 2: p1(1) = -B / 2
Set inloop(2) = Acadapp.ActiveDocument.ModelSpace.AddCircle(p1, B / 6)
p1(0) = A * 3 / 6 + B / 6 * Cos(PI / 4): p1(1) = -B / 2 + B / 6 * Sin(PI / 4)
Set inloop(3) = Acadapp.ActiveDocument.ModelSpace.AddLine(p1, inpnt2)
p1(0) = 0: p1(1) = 0
Set inloop(4) = Acadapp.ActiveDocument.ModelSpace.AddLine(inpnt2, p1)
hatchObj.AppendOuterLoop (inloop)       ‘执行到这一行时出错
hatchObj.Evaluate

End Sub

雪山飞狐_lzh

边界应首尾相连，圆用弧代替

陈琳

谢谢，学习时知道边界首尾相边，但没想到用弧代替圆。又学到一招，希望能多交流。再次谢谢!

Private Sub Command1_Click()

A=2:B=1

Dim hatchObj As AcadHatch, patternName As String, PatternType As Long
Dim bAssociativity As Boolean, inloop(0 To 4) As AcadEntity
patternName = "SOLID"
PatternType = 0
bAssociativity = False

Set hatchObj = Acadapp.ActiveDocument.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
' 为阴影创建外部边界
p2(0) = 0: p2(1) = 0
Set inloop(0) = Acadapp.ActiveDocument.ModelSpace.AddLine(p2, inpnt)
p1(0) = A / 2 - B / 6 * Cos(PI / 4): p1(1) = -B / 2 - B / 6 * Sin(PI / 4)
Set inloop(1) = Acadapp.ActiveDocument.ModelSpace.AddLine(inpnt, p1)
p1(0) = A / 2: p1(1) = -B / 2
Set inloop(2) = Acadapp.ActiveDocument.ModelSpace.AddArc(p1, B / 6, PI / 4, PI * 5 / 4)'更改为这样就行了。

p1(0) = A * 3 / 6 + B / 6 * Cos(PI / 4): p1(1) = -B / 2 + B / 6 * Sin(PI / 4)
Set inloop(3) = Acadapp.ActiveDocument.ModelSpace.AddLine(p1, inpnt2)
p1(0) = 0: p1(1) = 0
Set inloop(4) = Acadapp.ActiveDocument.ModelSpace.AddLine(inpnt2, p1)
hatchObj.AppendOuterLoop (inloop)  

hatchObj.Evaluate

End Sub