Тема: From ModelSpace to Plot

Как минуя Layuot заспечатать чертеж из ModelSpace

Re: From ModelSpace to Plot

> VadimR
Вот нашел в загашнике, может извлечешь
что полезное

Option Explicit
Sub PrintModel()
Dim PtConfigs As AcadPlotConfigurations
Dim PlotConfig As AcadPlotConfiguration
Dim PtObj As AcadPlot
Dim BackPlot As Variant
With ThisDrawing
.ActiveSpace = acModelSpace
ZoomExtents
Set PtObj = .Plot
Set PtConfigs = .PlotConfigurations
PtConfigs.Add ("PDF")
Set PlotConfig = PtConfigs.Item("PDF")
With PlotConfig
.PlotType = acExtents
.RefreshPlotDeviceInfo
.ConfigName = "DWG To PDF.pc3"
.RefreshPlotDeviceInfo
.StyleSheet = "monochrome.ctb"
.RefreshPlotDeviceInfo
.CanonicalMediaName = "ISO_expand_A4_(210.00_x_297.00_MM)"
.StandardScale = acScaleToFit
.RefreshPlotDeviceInfo
End With
BackPlot = .GetVariable("BACKGROUNDPLOT")
.SetVariable "BACKGROUNDPLOT", 0
.Plot.PlotToDevice (PlotConfig.ConfigName)
.SetVariable "BACKGROUNDPLOT", BackPlot
PtConfigs.Item("PDF").Delete
Set PlotConfig = Nothing
End With
End Sub

~'J'~

Re: From ModelSpace to Plot

> VadimR
Файл "DWG To PDF.pc3" на моем компьютере расположен
по адресу:
C:\Documents and Settings\admin\Application Data\Autodesk\AutoCAD 2008\R17.1\enu\Plotters
~'J'~

Re: From ModelSpace to Plot

Пытался переделать код для печати прямоуголнойй области и начал получат сообшхение об ошибке: "Incorrect number of elements in SafeArray" Код приведен ниже:

Sub PrintModel()
Dim PtConfigs As AcadPlotConfigurations
Dim PlotConfig As AcadPlotConfiguration
Dim PtObj As AcadPlot
Dim BackPlot As Variant
Dim lowerLeft(2) As Double, upperRight(2) As Double
lowerLeft(0) = 0: lowerLeft(1) = 0
upperRight(0) = 800: upperRight(1) = 400
With ThisDrawing
BackPlot = .GetVariable("BACKGROUNDPLOT")
.SetVariable "BACKGROUNDPLOT", 0
.ActiveSpace = acModelSpace
ZoomExtents
Set PtObj = .Plot
Set PtConfigs = .PlotConfigurations
PtConfigs.Add ("PDF")
Set PlotConfig = PtConfigs.Item("PDF")
    With PlotConfig
        .SetWindowToPlot lowerLeft, upperRight
        .PlotType = acWindow
        .RefreshPlotDeviceInfo
        .ConfigName = "PDFCreator.pc3"
        .RefreshPlotDeviceInfo
        .StyleSheet = "monochrome.ctb"
        .RefreshPlotDeviceInfo
        .CanonicalMediaName = "A4" ' "ISO_expand_A4_(210.00_x_297.00_MM)"
        .StandardScale = acScaleToFit
        .RefreshPlotDeviceInfo
    End With
.Plot.PlotToDevice (PlotConfig.ConfigName)
.SetVariable "BACKGROUNDPLOT", BackPlot
PtConfigs.Item("PDF").Delete
Set PlotConfig = Nothing
End With
End Sub

Re: From ModelSpace to Plot

РЕШЕНИЕ

Sub PlotFromModelSpace(lowerLeft, upperRight, Optional StyleSheet As String = "monochrome.ctb", _
Optional Centering As Boolean = True, Optional currConfigName As String = "PDFCreator")
Dim llUb As Integer, urUb As Integer
llUb = safeubound(lowerLeft)
urUb = safeubound(upperRight)
If llUb = -1 Or urUb = -1 Then Exit Sub
If llUb > 1 Then ReDim Preserve lowerLeft(1)
If urUb > 1 Then ReDim Preserve upperRight(1)
With ThisDrawing
    BackPlot = .GetVariable("BACKGROUNDPLOT")
    .SetVariable "BACKGROUNDPLOT", 0
    If .ActiveSpace = acPaperSpace Then
       .MSpace = True
       .ActiveSpace = acModelSpace
    End If
    With .ModelSpace.Layout
        .CenterPlot = Centering
        .StyleSheet = StyleSheet
        .RefreshPlotDeviceInfo
        .ConfigName = currConfigName
        .PlotType = acWindow
        .StandardScale = acScaleToFit
        .SetWindowToPlot lowerLeft, upperRight
        .CanonicalMediaName = "A4"
        .PlotRotation = IIf(Abs(upperRight(1) - lowerLeft(1)) >= Abs(upperRight(0) - lowerLeft(0)), AcPlotOrientation.acPlotOrientationPortrait, AcPlotOrientation.acPlotOrientationLandscape)
    End With
    .Plot.PlotToDevice
    .SetVariable "BACKGROUNDPLOT", BackPlot
End With
End Sub

Re: From ModelSpace to Plot

а если я заранее знаю координаты области (x1,y1,x2,y2) и формат рамки, то как это реализовать, чтобы программно происходило выделение? причем в одном файле в ряд может быть десятки рамок...
выделение через .Select acSelectionSetAll point1,point2 пройдет?

Re: From ModelSpace to Plot

выделение через .Sel ect acSel ectionSetAll point1,point2 пройдет?

не пройдет.
1.

Sub plotFr omModelSpace(ByVal x1, ByVal y1, ByVal x2, ByVal y2, Optional StyleSheet As String = "solid.ctb", Optional Centering As Boolean = True, Optional currConfigName As String = "PDFCreator.pc3")

Dim lowerLeft(1) As Double, upperRight(1) As Double, BackPlot
lowerLeft(0) = x1: lowerLeft(1) = y1
upperRight(0) = x2: upperRight(1) = y2

..............
end sub

2.

  for i = 0 to ubound(x1Arr)
    plotFr omModelSpace x1Arr(i),y1Arr(i), x2Arr(i),y2Arr(i)
  next i

Re: From ModelSpace to Plot

Спасибо, разобрался. Я так понял что .Plot.PlotToDevice создает файл *-Model.pdf . А есть ли вариант добавить в этот же файл 2ой лист? Может кто работал с другими программами, например с pdf factory, там есть функция добавления следующего листа в файл ?