Тема от hunter_best (изменено: Николай Сайдаль, 10 октября 2013г. 14:58:21)

  • На форуме с 8 октября 2013г.
  • Сообщений: 1
  • Спасибо: 0

Тема: DisplayPlotPreview выдаёт ошибку Method 'Application' of object "IAcadPlot' failed

Доброго времени суток. Уважаемые гуру VBA помогите, пожалуйста, решить проблему. При попытке вызвать предварительный просмотр печатаемого листа с помощью метода DisplayPlotPreview выдаётся ошибка "Method 'Application' of object 'IAcadPlot' failed" в следующем коде

Sub Preview()

Dim Plotlayout As AcadLayout
Dim oPlot As AcadPlot
Dim PntNach(0 To 1) As Double
Dim PntKon(0 To 1) As Double
        
    PntNach(0) = 0
    PntNach(1) = 0
    
    PntKon(0) = 100
    PntKon(1) = 100
    
    change_Target
        
    ReDim Preserve AddedLayouts(1 To 1)
    Set oPlot = ThisDrawing.Plot
    Set PlotConfig = ThisDrawing.PlotConfigurations
    
        
    Set Plotlayout = ThisDrawing.ModelSpace.layout
    With Plotlayout
        .ConfigName = "Xerox WorkCentre 5016 A4.pc3"
        .SetCustomScale 1, 1
        ThisDrawing.Regen acActiveViewport
        .CanonicalMediaName = "A4"
        .CenterPlot = True
        .StyleSheet = "monochrome.ctb"
        .SetWindowToPlot PntNach, PntKon
        .PlotType = acWindow
        .PlotRotation = ac0degrees
    End With
        
    AddedLayouts(1) = ThisDrawing.ActiveLayout.Name
    LayoutList = AddedLayouts
    
    oPlot.SetLayoutsToPlot LayoutList
    [b]oPlot.DisplayPlotPreview acFullPreview[/b]
   
End Sub

Странно, что сперва работало нормально. Потом начали появляться ошибки после 2-го запуска. А теперь с каждым запуском.

Буду очень признателен за помощь.

  • На форуме с 29 апреля 2010г.
  • Сообщений: 56
  • Спасибо: 2

Re: DisplayPlotPreview выдаёт ошибку Method 'Application' of object "IAcadPlot' failed

Добрый день, проблема в том что Вы устанавливаете конфигурацию печати только для модели, а печатаете все листы подряд поэтому ошибка и вылетает. Необходимо для каждого листа установить параметры печати- перебрать циклом все листы с установкой для каждого листа своих параметров. Если будет полезно мои коды печати:

Private Sub CB_PlotPreview_Click()
'On Error Resume Next
Dim StrPlotName As String
Dim frmName As String
Dim Plot_ConfigPlot As Variant
Plot_ConfigPlot = Change_plot(CB_FiltrPrinterName.Text, Cb_FormatFrame.Text)
'Plot_ConfigPlot(0)-каноническое имя
'Plot_ConfigPlot(0)-имя принтера *.pc3
 SetConfigPloter Plot_ConfigPlot(0), Plot_ConfigPlot(1)
  Me.Hide
  ThisDrawing.Plot.DisplayPlotPreview acPartialPreview
  Me.show
'On Error GoTo 0
End Sub

Private Sub SetConfigPloter(StrPlotName, n_f)
    
    Dim ObjLayout As AcadLayout
    Dim Formats As Variant
    Set ObjLayout = ThisDrawing.ActiveLayout
    Set layout = ThisDrawing.ModelSpace.layout
    Dim objSpace As AcadBlock
    Set objSpace = GetSpase
    Dim lcnt As Long
    Dim x As Integer
    Dim point1(0 To 1) As Double
    Dim point2(0 To 1) As Double
    Dim newValue(0 To 1) As Double
    Dim PaperWidth As Double
    Dim PaperHeight As Double
    
    point1(0) = Val(Count_XY1.List(0, 0))
    point1(1) = Val(Count_XY1.List(1, 0))
    point2(0) = Val(Count_XY2.List(0, 0))
    point2(1) = Val(Count_XY2.List(1, 0))
    
    newValue(0) = Val(Plot_U.TB_ORIGINX.Text)
    newValue(1) = Val(Plot_U.TB_ORIGINY.Text)
       
  If objSpace Is ThisDrawing.ModelSpace Then
    With layout
      .RefreshPlotDeviceInfo
      .ConfigName = StrPlotName
      .RefreshPlotDeviceInfo
      .CanonicalMediaName = n_f
      .PlotOrigin = newValue
      .PaperUnits = acMillimeters
      .SetWindowToPlot point1, point2
      .PlotType = acWindow
      .GetPaperSize PaperWidth, PaperHeight
      If Pl_Albom.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac90degrees
         Else
        .PlotRotation = ac0degrees
        End If
      End If
      If PL_Portret.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac0degrees
         Else
        .PlotRotation = ac90degrees
        End If
      End If
      .SetCustomScale TB_NUMERATOR.Text, TB_DENOMINATOR.Text
      .StyleSheet = CB_PRINTSTYLE.Text
      .PlotWithPlotStyles = True
      .PlotWithLineweights = True
    End With
   Else
     With ObjLayout
      .RefreshPlotDeviceInfo
      'MsgBox StrPlotName
      .ConfigName = StrPlotName
     ' MsgBox n_f
      .RefreshPlotDeviceInfo
      .CanonicalMediaName = n_f
      .PlotOrigin = newValue
      .PaperUnits = acMillimeters
      .SetWindowToPlot point1, point2
      .PlotType = acWindow
      .GetPaperSize PaperWidth, PaperHeight
      If Pl_Albom.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac90degrees
         Else
        .PlotRotation = ac0degrees
        End If
      End If
      If PL_Portret.Value = True Then
        If PaperWidth < PaperHeight Then
        .PlotRotation = ac0degrees
         Else
        .PlotRotation = ac90degrees
        End If
      End If
      .SetCustomScale TB_NUMERATOR.Text, TB_DENOMINATOR.Text
      .StyleSheet = CB_PRINTSTYLE.Text
      .PlotWithPlotStyles = True
      .PlotWithLineweights = True
    End With
   End If

End Sub
Public Function GetSpase() As AcadBlock
  Dim objSpace As AcadBlock
  Dim intTILEMODE As Integer
  Dim intCVPORT As Integer
  On Error GoTo Exit_Here
  intTILEMODE = CInt(ThisDrawing.GetVariable("TILEMODE"))
  If intTILEMODE = 1 Then
    Set objSpace = ThisDrawing.ModelSpace
  Else
    intCVPORT = CInt(ThisDrawing.GetVariable("CVPORT"))
    If intCVPORT = 1 Then
      Set objSpace = ThisDrawing.PaperSpace
    Else
      Set objSpace = ThisDrawing.ModelSpace
    End If
  End If
Exit_Here:
  Set GetSpase = objSpace
  Set objSpace = Nothing
End Function