Тема: From ModelSpace to Plot
Как минуя Layuot заспечатать чертеж из ModelSpace
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → From ModelSpace to Plot
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Как минуя Layuot заспечатать чертеж из ModelSpace
> 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'~
> VadimR
Файл "DWG To PDF.pc3" на моем компьютере расположен
по адресу:
C:\Documents and Settings\admin\Application Data\Autodesk\AutoCAD 2008\R17.1\enu\Plotters
~'J'~
Пытался переделать код для печати прямоуголнойй области и начал получат сообшхение об ошибке: "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
РЕШЕНИЕ
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
а если я заранее знаю координаты области (x1,y1,x2,y2) и формат рамки, то как это реализовать, чтобы программно происходило выделение? причем в одном файле в ряд может быть десятки рамок...
выделение через .Select acSelectionSetAll point1,point2 пройдет?
выделение через .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
Спасибо, разобрался. Я так понял что .Plot.PlotToDevice создает файл *-Model.pdf . А есть ли вариант добавить в этот же файл 2ой лист? Может кто работал с другими программами, например с pdf factory, там есть функция добавления следующего листа в файл ?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → From ModelSpace to Plot
Форум работает на PunBB, при поддержке Informer Technologies, Inc