|
|
发表于 2004-5-29 22:07:00
|
显示全部楼层
我设计边界时没有用圆，我只用圆弧和轻便多义线封闭，而且我的同学做他的设计时已经实现。我现在发一个自己任意做实验的程序。这个程序也出现同样的情况。
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
|
|
置顶卡
