每次运行程序(vba) 只能打一张图然后弹出错误框:
Option Explicit Sub tt() Dim fn As String Dim strpath As String Dim doc As AcadDocument Dim docs As AcadDocuments Dim mdl As AcadModelSpace Dim plt As AcadPlot Dim dl(1) As Double, ur(1) As Double dl(0) = 443.2937: dl(1) = 203.4134 ur(0) = 708.265: ur(1) = 522.5616 strpath = "E:\重要工程\控制\控制点点之记\123\" Dim filname As String, dirf() As String Dim i As Integer, j As Integer filname = Dir(strpath + "*.dwg") i = 1 Do While filname <> "" ReDim Preserve dirf(1 To i) As String dirf(i) = strpath + filname filname = Dir i = i + 1 Loop j = UBound(dirf) Set docs = ThisDrawing.Application.Documents For i = 1 To j Set doc = docs.Open(dirf(i)) ThisDrawing.Application.ZoomExtents Set mdl = doc.ModelSpace With mdl.Layout .ConfigName = "hp LaserJet 1320 PCL 6" .StandardScale = acScaleToFit .PlotRotation = ac0degrees .SetWindowToPlot dl, ur .PlotType = acWindow .CenterPlot = True End With ' On Error Resume Next doc.Plot.PlotToDevice doc.Close False Next i MsgBox "finish", vbOKOnly, "OK" End Sub |