对不起

wfcst2004

对不起上次程序有错误，改后的在此：但仍就不行：

On Error Resume Next
  Dim acadApp As AcadApplication
  Dim acaddoc As AcadDocument
 Set acadApp = GetObject(, "AutoCAD.Application")
'    acaApp.Command = script.exe
    If Err Then
        Err.Clear
      Set acadApp = CreateObject("AutoCAD.Application")
      Set acaddoc = acadApp.ActiveDocument
      acadApp.Visible = True
        If Err Then
            MsgBox Err.Description
            Exit Sub
        End If
    End If
    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(0, "ansi31", True)
 Dim innerloop(0 To 0) As AcadEntity
 Dim outerloop(0 To 0) As AcadEntity
 Dim Plineobj As AcadLWPolyline
 Set acaddoc = acadApp.ActiveDocument
 Dim points(0 To 7) As Double
 points(0) = 10: points(1) = 10
 points(2) = 30: points(3) = 50
 points(4) = 70: points(5) = 20
 Dim stp0(0 To 2) As Double
 Dim enp0(0 To 2) As Double
  stp0(0) = 70: stp0(1) = 20: enp0(2) = 0
 enp0(0) = 10: enp0(1) = 10: enp0(2) = 0
 Set innerloop(0) = acadApp.ActiveDocument.ModelSpace.AddLine(stp0, enp0)
' points(6) = 10: points(7) = 10
 Set innerloop(0) = acaddoc.ModelSpace.AddLightWeightPolyline(points)
 Dim centerpoint10(0 To 2) As Double
 Dim endpoint10 As Double
 Dim radius10 As Double
 centerpoint10(0) = 20: centerpoint10(1) = 20: centerpoint10(2) = 0#
  radius10 = 4
 Set outerloop(0) = acadApp.ActiveDocument.ModelSpace.AddCircle(centerpoint10, radius10)
  hatchobj.AppendOuterLoop (outerloop)
hatchobj.AppendInnerLoop (innerloop)
hatchobj.Evaluate
acadApp.ActiveDocument.Regen True
  ZoomExtents
 ZoomAll