对不起

wfcst2004 发表于 2006-1-3 11:58:00

对不起上次程序有错误，改后的在此：但仍就不行：
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

页: [1]

明经CAD社区's Archiver

对不起