Plot (печать из NanoCAD)

[ISL]

есть спец. метод GetPaperMargins: _http://vbamodel.narod.ru/AutoCAD/idh_getpapermargins.htm

но только чего-то у меня он не работает =(

GetPaperSize тоже.

я что-то не так делаю, или они просто не поддерживаются в нано?

 

Методы реализованы. Они возвращают что-то не то, или возникает ошибка при их вызове?

 

в нано нет переменной PLOTOFFSET?

 

Переменная не реализована.

[ISL]

1) Как автоматически при запуске nanocad запускать .Net приложение и команду из него. (При вызове команды срабатывает конструктор в котором я подписываюсь на событие завершения печати)

 

Приложение можно поместить в "Чемодан" автозагрузки команды APPLOAD, или прописать в секцию [\NetModules] в файл nApp.ini, расположенный рядом с NCad.ini.

 

При загрузке .NET модуля автоматически вызывается IExtensionApplication.Initialize(), см. "c:\Program Files (x86)\Nanosoft\nanoCAD 5.1\SDK\samples\Mgd\SymbolsMgd\TestCommands.cs", код инициализации луче размещать там.

[Dmitros]

ISL спасибо, все получилось. Единственно осталось выяснить закончилась ли команда plot печатью или окно с настройками печати просто закрыли. Есть идея решения этой пооблемы через просмотр очереди печати.

[horus]

День добрый, подскажите как использовать функцию SetLayoutsToPlot, точнее что туда передать.

Как не извращался, не смог нащупать верный параметр. Цель распечатать все листы кроме модели, список имен листов собираю в массив, а вот что дальше, не могу понять.

 

Если не сложно пример можно на JS либо на VBS

Изменено 9 июля, 2014 пользователем horus

[Robink]

День добрый, подскажите как использовать функцию SetLayoutsToPlot, точнее что туда передать.

Как не извращался, не смог нащупать верный параметр. Цель распечатать все листы кроме модели, список имен листов собираю в массив, а вот что дальше, не могу понять.

 

Если не сложно пример можно на JS либо на VBS

 

Я открываю листы по очереди и выполняю plot.plottodevice.

VBS

ThisDrawing.Utility.Prompt("Печать всех страниц")

dim olayt
For Each olayt In ThisDrawing.Layouts
   If Not olayt.Name = "Model" Then

	    ThisDrawing.ActiveLayout = olayt
	    ThisDrawing.Plot.PlotToDevice

	    Dim PauseTime, Start, Finish, TotalTime
	    PauseTime = 1    ' Set duration.
	    Start = Timer    ' Set start time.
	    Do While Timer < Start + PauseTime
	    Loop

   End If
next 

 

Код примера библиотеки .Net

Option Explicit On
Imports Teigha.Runtime
Imports nanoCAD
Imports OdaX
Imports System.Runtime.InteropServices.Marshal
Imports System.Runtime.InteropServices.COMException
Public Class Class1
<CommandMethod("pltlayouts", CommandFlags.UsePickSet + CommandFlags.Redraw + CommandFlags.Modal)> _
Public Sub plttodevice()
	Dim appAcad As nanoCAD.Application
	'проверяем на наличие запущенного нанокада
	Try
		appAcad = CType(GetActiveObject("NanoCAD.Application"), nanoCAD.Application)
		If appAcad Is Nothing Then Throw New Exception("Нет запущенного приложения NanoCAD")
	Catch ex As Exception
		'если не удалось получить приложение
		Exit Sub
	End Try
	If appAcad.Documents.Count = 0 Then
		Exit Sub
	End If
	Dim myAut As nanoCAD.Document = appAcad.ActiveDocument
	Dim plt As Plot = myAut.Plot
	For Each olayt As OdaX.AcadLayout In myAut.Layouts
		If Not olayt.Name = "Model" Then
			myAut.ActiveLayout = olayt
			plt.PlotToDevice()
		End If
	Next
End Sub
End Class

Изменено 9 июля, 2014 пользователем Robink

[Robink]

Для программной печати лучше не вызывать команду PLOT, тем более, что консольный вариант команды, -PLOT, ещё не реализован, а использовать метод COM интерфейса Plot.PlotToDevice().

Попробовал использовать, через C#, но метод обязательно просит object plotconfig, а в vb этот параметр опциональный, пробовал тут кидать активную страницу, так ничего и не получилось. Как скормить ему страницу в C#?

[ISL]

Попробуйте передать Type.Missing.

[Robink]

Попробуйте передать Type.Missing.

Работает.

[westwind]

Вопрос.

Nanocad 7.0. Multicad. C#

---

1) Пытаюсь печатать внутри плагина через COM-интерфейс .

Компилируется dll без ошибок, загружается, все функции работают кроме данной:

nanoCAD.Application app = Marshal.GetActiveObject("nanocad.Application") as nanoCAD.Application;
nanoCAD.Document doc = app.ActiveDocument;
(doc.Plot as InanoCADPlot).PlotToDevice();

даже прерывание при вызове функции не срабатывает. Что я делаю не так?

 

2) возможно ли программно (внутри плагина) установить области печати для дальнейшей печати или через Plot.PlotToDevice или через команду PLOT?!!

[gizmo_zx]

Бодрого дня.

Есть массив пар точек (левый нижний угол, правый верхний).

Хотелось бы настроить принтер в интерфейсе Nanocad.

И просто задавать область печати в цикле.

 

Подскажите рабочий примерчик печати из Vb.net.

 

 

[gizmo_zx]

Бодрого дня.

Код взял отсюда http://fordewind.org/wiki/doku.php?id=автомат_листы

К сожалению не завелся

 

Подозреваю, что в :

Function CreateLayout()

 

Set PSVport = ThisDrawing.PaperSpace.AddPViewport(ptc, XSize, YSize)

 в ptc= empty

 

Спойлер

Dim list(999), Xpos(999), Ypos(999) '999 листов должно хватить, ятд
Dim myobj, XSize, YSize, PaperSize, orientation
Dim ppt0, ppt1(2), pt0, pt1
Dim ptc, pptc(2)
Sub S_plot_1()

On Error Resume Next
Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True

Dim ThisDrawing As nanoCAD.Document
Set ThisDrawing = app.ActiveDocument

Dim ms
Set ms = ThisDrawing.ModelSpace

Dim ut As nanoCAD.Utility
Set ut = ThisDrawing.Utility

ut.Prompt "Автоматизация печати"

'Dim myobj, XSize, YSize, PaperSize, orientation
'Dim ppt0, ppt1(2), pt0, pt1
'Dim ptc, pptc(2)
'Dim list(999), Xpos(999), Ypos(999) '999 листов должно хватить, ятд

Dim i, m
m = 0

'удаляем все листы, оставляем только пустой лист "0"
deletelayouts

'прогоняем все объекты модели. если среди них есть блоки с определёнными названиями, сохраняем номер и точку вставки
For i = 0 To ms.Count - 1
    Set myobj = ms.Item(i)
    If (myobj.ObjectName = "AcDbBlockReference") Then
        If (myobj.Name = "КЖ-А1" Or myobj.Name = "КЖ-А2" Or myobj.Name = "КЖ-А3" Or myobj.Name = "КЖ-А4") Then
            m = m + 1 'счётчик листов
            nabor myobj, i 'сохраняем координаты рамок и номер элемента в списке
        End If
    End If
Next

Xsort 'запускаем функцию сортировки листов по положению в модели (слева направо)
Ysort 'сортируем листы по Y
    

'создаём лэйауты для отсортированного списка листов
For i = 1 To m
    Set myobj = ms.Item(list(i))
    If (myobj.Name = "КЖ-А1") Then
        CreateLayout myobj, 840, 594, "ISO A1 (594.00 x 841.00 мм)", 3
    End If
'    else if (myobj.name = "КЖ-А2") then
'        CreateLayout myobj, 594, 420, "ISO A2 (420.00 x 594.00 мм)", 3
'    else if (myobj.name = "КЖ-А3") then
'        CreateLayout myobj, 420, 297, "ISO A3 (297.00 x 420.00 мм)", 3
    If (myobj.Name = "КЖ-А4") Then
        CreateLayout myobj, 210, 297, "ISO A4 (210.00 x 297.00 мм)", 2
    End If
Next

'удаляем лист "0"
deletezero

ut.Prompt "Готово, проверяй!"

End Sub
' ===== КОНЕЦ. Дальше функции =====

'сохраняем координаты рамок и номер элемента в списке выбора
Function nabor(myobj, i)
    pt0 = myobj.InsertionPoint
    ppt0 = ut.CreateSafeArrayFromVector(pt0)
    list(m) = i
    Xpos(m) = Int(ppt0(0))
    Ypos(m) = Int(ppt0(1) / 3000) * 3000
End Function

'сортируем листы по X
Function Xsort()
    On Error Resume Next
    ut.Prompt "Сортировка по горизонтали"
    Dim a, b
    For a = 1 To m - 1
        For b = 1 To m - 1
            If Xpos(b) > Xpos(b + 1) Then
                temp = Xpos(b)
                Xpos(b) = Xpos(b + 1)
                Xpos(b + 1) = temp
                
                temp = list(b)
                list(b) = list(b + 1)
                list(b + 1) = temp
                
                temp = Ypos(b)
                Ypos(b) = Ypos(b + 1)
                Ypos(b + 1) = temp
            End If
        Next
    Next
End Function

'сортируем листы по Y
Function Ysort()
    On Error Resume Next
    ut.Prompt "Сортировка по вертикали"
    Dim a, b
    For a = 1 To m - 1
        For b = 1 To m - 1
            If Ypos(b) < Ypos(b + 1) Then
                temp = Xpos(b)
                Xpos(b) = Xpos(b + 1)
                Xpos(b + 1) = temp
                
                temp = list(b)
                list(b) = list(b + 1)
                list(b + 1) = temp
                
                temp = Ypos(b)
                Ypos(b) = Ypos(b + 1)
                Ypos(b + 1) = temp
            End If
        Next
    Next
End Function

'создаём лэйауты
Function CreateLayout(myobj, XSize, YSize, PaperSize, orientation)
    On Error Resume Next
    'левая нижняя точка - совпадает с точкой вставки блока
    pt0 = myobj.InsertionPoint
    ppt0 = ut.CreateSafeArrayFromVector(pt0)
    
    'правая верхняя точка
    ppt1(0) = ppt0(0) + XSize * 100 * myobj.XScaleFactor
    ppt1(1) = ppt0(1) + YSize * 100 * myobj.XScaleFactor
    ppt1(2) = 0
    'ut.CreateTypedArray pt1, 5, ppt1(0), ppt1(1), ppt1(2)
    
    ut.Prompt "Создаём лист #" & i
    
    'создаём новый лист
    Dim olayt
    Set olayt = ThisDrawing.Layouts.Add(i)
    ThisDrawing.ActiveLayout = olayt 'переключаемся на новый лист
    'ThisDrawing.MSpace = FALSE 'отключаем модель (хз зачем)
    
    'отключаем "Масштаб в единицах пространства листа" для корректного отображения линий
    ThisDrawing.SetVariable "PSLTSCALE", 0
    
    'настройки печати
    olayt.ConfigName = "Встроенный PDF-принтер" 'плоттер
    Dim Retval, r
    Retval = ut.CreateSafeArrayFromVector(olayt.GetCanonicalMediaNames())
    For Each r In Retval
        'ut.prompt olayt.GetLocaleMediaName(r)
        If (olayt.GetLocaleMediaName(r) = PaperSize) Then
            olayt.CanonicalMediaName = r 'выбираем формата листа
            Exit For
        End If
    Next
    olayt.PlotRotation = orientation 'поворот 2-книжная 3-альбомная
    'olayt.PlotType = 4 'рамка
    'olayt.SetWindowToPlot pt1, pt2 'область печати
    'olayt.PlotOrigin = "0,0" 'отступы
    'olayt.CenterPlot=true 'центрировать
    olayt.StandardScale = 16 '16 - 1:1 ,  0 - вписать
    olayt.StyleSheet = "КЖ_серые оси.ctb" 'стиль печати - монохром
    'цветозависимый (хз как настроить, но вроде по умолчанию стоит)
    olayt.PlotWithPlotStyles = True 'учитывать стили печати
    olayt.PlotWithLineweights = True 'учитывать вес линий
    olayt.PaperUnits = 1 'acMillimeters 'ед. измерения
    olayt.RefreshPlotDeviceInfo
    
    'координаты центра видового экрана
    pptc(0) = XSize / 2
    pptc(1) = YSize / 2
    pptc(2) = 0
    ut.CreateTypedArray ptc, 5, pptc(0), pptc(1), pptc(2)
    
    'создадим видовой экран
    Dim PSVport
    Set PSVport = ThisDrawing.PaperSpace.AddPViewport(ptc, XSize, YSize)
    
    'непечатный слой
    Dim layer
    Set layer = ThisDrawing.Layers.Add("КЖ_непечатаемый")
    layer.Plottable = False
    PSVport.layer = "КЖ_непечатаемый"
    
    'масштаб отображения
    PSVport.CustomScale = 1 / (100.1 * myobj.XScaleFactor)
    
    'координаты центра видимой зоны
    pptc(0) = (ppt0(0) + ppt1(0)) / 2
    pptc(1) = (ppt0(1) + ppt1(1)) / 2
    pptc(2) = 0
    ut.CreateTypedArray ptc, 5, pptc(0), pptc(1), pptc(2)
    PSVport.Target = ptc
    
    'ThisDrawing.Regen 1
End Function

'удаляем все листы, оставляем только пустой лист "0"
Function deletelayouts()
    On Error Resume Next
    Dim lay
    Set lay = ThisDrawing.Layouts.Add("0")
    Dim a, b
    b = ThisDrawing.Layouts.Count - 1
    For a = 0 To b
        If (ThisDrawing.Layouts.Item(b - a).Name <> "Model" And ThisDrawing.Layouts.Item(b - a).Name <> "0") Then
            ThisDrawing.Utility.Prompt "Лист " & ThisDrawing.Layouts.Item(b - a).Name & " удалён"
            ThisDrawing.Layouts.Item(b - a).Delete
        End If
    Next
End Function

'удаляем лист "0"
Function deletezero()
    On Error Resume Next
    Dim b
    For b = 0 To ThisDrawing.Layouts.Count - 1
        If (ThisDrawing.Layouts.Item(b).Name = "0") Then
            ThisDrawing.Utility.Prompt "Лист " & ThisDrawing.Layouts.Item(b).Name & " удалён"
            ThisDrawing.Layouts.Item(b).Delete
            Exit For
        End If
    Next
End Function
 

 

На всякий случай сами файлы

 

Plot0.xls Без имени0.dwg

Изменено 2 июня, 2021 пользователем gizmo_zx

[doctorraz]

1 час назад, gizmo_zx сказал:

Подскажите рабочий примерчик печати из Vb.net.

Покажи, что сделано и в чем затык?

Если нужен готовый код то РЕВЕРС тебе поможет

добавлено через 0 минут

Дот нет set  не умеет))

[gizmo_zx]

Хотел по быстрому перевести на vb.net вот это http://engineerbox.ru/2011/08/24/autocad-pechat-iz-modeli/

Макрос нормально работал в Autocad, с переездом на Nanocad все грустно.

На Vb.net  пока ничего нет, сам хотел пример глянуть. (сам то я вовсе не программист)

 

На  VBA для Excel нарыл вот чего:

Спойлер

Sub PrintModelSpace()

Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True

Dim ThisDrawing As nanoCAD.Document
Set ThisDrawing = app.ActiveDocument

    ' Проверим что активно пространство модели
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        ThisDrawing.MSpace = True
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    
    
    '-------------------------
    '
    '
    Dim t1 As Variant  'точки
    Dim t2 As Variant
    t1 = ThisDrawing.Utility.GetPoint(, "введите первый угол прямоугольника или выХод: ")
    t2 = ThisDrawing.Utility.GetCorner(t1, "введите второй угол прямоугольника или выХод: ")
    ReDim Preserve t1(0 To 1)
    ReDim Preserve t2(0 To 1)
    ThisDrawing.ModelSpace.Layout.PlotType = acWindow            'выделение рамкой.
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot t1, t2
    'pr.DisplayPlotPreview acFullPreview
    
    
    
    
    ' Зададим границы и масштаб печатаемой области.
    ThisDrawing.ModelSpace.Layout.PlotType = acExtents
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    
    ' И число копий
    ThisDrawing.Plot.NumberOfCopies = 1
    
    ' Запустим печать
    ThisDrawing.Plot.PlotToDevice
End Sub
 

 

Вроде как подойдет для меня.

Только выставляется в настройках печати - Область печати = экран

Выставляю рамку, запускаю код. 

Печатаю в ПРФ , получаю границы экрана , а не рамку.

Захожу в настройки печати , а там действительно экран.

Код работает но криво.

Настройки "PlotType" смотрел тут http://vbamodel.narod.ru/AutoCAD/idh_plottype.htm

[Светлана Мирончик]

В строке 

ThisDrawing.ModelSpace.Layout.PlotType = acExtents 

вместо acExtents должно быть acWindow.

И еще кривая работа этого кода может быть связана с тем, что координаты точек нужно перевести в Display coordinate system.

 

[gizmo_zx]

Все равно соскакивает на "экран"

Спойлер

Sub PrintModelSpace()

Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True

Dim ThisDrawing As nanoCAD.Document
Set ThisDrawing = app.ActiveDocument




    ' Проверим что активно пространство модели
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        ThisDrawing.MSpace = True
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    
    
    '-------------------------
    '
    '
    Dim t1 As Variant  'точки
    Dim t2 As Variant
    t1 = ThisDrawing.Utility.GetPoint(, "введите первый угол прямоугольника или выХод: ")
    t1 = ThisDrawing.Utility.TranslateCoordinates(t1, acWorld, acDisplayDCS, False)
    
    
    t2 = ThisDrawing.Utility.GetCorner(t1, "введите второй угол прямоугольника или выХод: ")
    t1 = ThisDrawing.Utility.TranslateCoordinates(t2, acWorld, acDisplayDCS, False)
    ReDim Preserve t1(0 To 1)
    ReDim Preserve t2(0 To 1)
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    ThisDrawing.ModelSpace.Layout.PlotType = acWindow            'выделение рамкой.
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot t1, t2
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    'ThisDrawing.ModelSpace.Layout.PlotType = acWindow
    'ThisDrawing.ModelSpace.Layout.DisplayPlotPreview acFullPreview
    ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    
    
    
    ' Зададим границы и масштаб печатаемой области.
'    ThisDrawing.ModelSpace.Layout.PlotType = acExtents
'    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    
    ' И число копий
    ThisDrawing.Plot.NumberOfCopies = 1

   ' Запустим печать
    ThisDrawing.Plot.PlotToDevice
End Sub

 

ThisDrawing.ModelSpace.Layout.PlotType = acExtents - закоментил

Utility.TranslateCoordinates(p1, acWorld, acDisplayDCS, False) - координаты перевел

но на предпросмотре вижу, что печатается экран

[Светлана Мирончик]

Здесь еще неправильный порядок действий. Метод SetWindowToPlot должен быть вызван до того, как plotType назначено значение acWindow. Без отработки SetWindowToPlot область печати "Рамка" не применится к plotType

[gizmo_zx]

В чем проблема, я так и не понял. В Acade код работает как надо.

Спойлер

Sub PrintModelSpace()

Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True

Dim ThisDrawing As nanoCAD.Document
Set ThisDrawing = app.ActiveDocument

' для acad от сюда , что выше закоментить



    ' Проверим что активно пространство модели
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        ThisDrawing.MSpace = True
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    
'    ThisDrawing.SendCommand "(command " & Chr(34) & _
'            "_PLAN" & Chr(34) & _
'            " " & Chr(34) & "?" & _
'            Chr(34) & ")" & vbCr
    '-------------------------
    '
    '
    Dim t1 As Variant  'точки
    Dim t2 As Variant
    t1 = ThisDrawing.Utility.GetPoint(, "введите первый угол прямоугольника или выХод: ")
    t1 = ThisDrawing.Utility.TranslateCoordinates(t1, acWorld, acDisplayDCS, False)
    
    
    t2 = ThisDrawing.Utility.GetCorner(t1, "введите второй угол прямоугольника или выХод: ")
    t2 = ThisDrawing.Utility.TranslateCoordinates(t2, acWorld, acDisplayDCS, False)
    ReDim Preserve t1(0 To 1)
    ReDim Preserve t2(0 To 1)
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    'ThisDrawing.ModelSpace.Layout.PlotType = acWindow            'выделение рамкой.
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot t1, t2
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    ThisDrawing.ModelSpace.Layout.PlotType = acWindow
    'ThisDrawing.ModelSpace.Layout.DisplayPlotPreview acFullPreview
    ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    
    
    
    ' Зададим границы и масштаб печатаемой области.
'    ThisDrawing.ModelSpace.Layout.PlotType = acExtents
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    
    ' И число копий
    ThisDrawing.Plot.NumberOfCopies = 1

   ' Запустим печать
    ThisDrawing.Plot.PlotToDevice
End Sub

 

 

Причем в Acade не зависит от последовательности:

    'ThisDrawing.ModelSpace.Layout.PlotType = acWindow            'выделение рамкой.
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot t1, t2

 

Или наоборот.

В Nanocade область печати все равно стоит в "экран"

Изменено 3 июня, 2021 пользователем gizmo_zx

[gizmo_zx]

Если влепить:

ThisDrawing.ModelSpace.Layout.PlotType = "4"  а не acWindow

Начинает работать с рамкой.

Но печатает "предыдущую" настройку, т.е. после отработки макроса, нажимаю настройку печати, Nanocad говорит: "Внимание! настройки печати были изменены в другой программе. Применить их вместо настроек печати nanoCad"

Я так понимаю, применение макроса меняет настройки, но не может их применить.

Спойлер

Sub PrintModelSpace()

Dim app As nanoCAD.Application
Set app = GetObject("", "nanoCAD.Application")
app.Visible = True
Dim ThisDrawing As nanoCAD.Document
Set ThisDrawing = app.ActiveDocument
' для acad от сюда , что выше закоментить



    ' Проверим что активно пространство модели
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        ThisDrawing.MSpace = True
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    
    '-------------------------
    Dim t1 As Variant  'точки
    Dim t2 As Variant
    t1 = ThisDrawing.Utility.GetPoint(, "введите первый угол прямоугольника или выХод: ")
    t1 = ThisDrawing.Utility.TranslateCoordinates(t1, acWorld, acDisplayDCS, False)
    t2 = ThisDrawing.Utility.GetCorner(t1, "введите второй угол прямоугольника или выХод: ")
    t2 = ThisDrawing.Utility.TranslateCoordinates(t2, acWorld, acDisplayDCS, False)
    ReDim Preserve t1(0 To 1)
    ReDim Preserve t2(0 To 1)
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    'ddd = (Str(ThisDrawing.ModelSpace.Layout.PlotType))
    'ThisDrawing.ModelSpace.Layout.PlotType = acWindow            'выделение рамкой.
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot t1, t2
    'ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    ThisDrawing.ModelSpace.Layout.PlotType = "4" 'выделение рамкой.
    'ThisDrawing.ModelSpace.Layout.DisplayPlotPreview acFullPreview
    'ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    'ddd = (Str(ThisDrawing.ModelSpace.Layout.PlotType))
    
    ' Зададим границы и масштаб печатаемой области.
    ' ThisDrawing.ModelSpace.Layout.PlotType = acExtents
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    
    ' И число копий
    ThisDrawing.Plot.NumberOfCopies = 1
    'ddd = (Str(ThisDrawing.ModelSpace.Layout.PlotType))
    ThisDrawing.ModelSpace.Layout.RefreshPlotDeviceInfo
    'ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    ' Запустим печать
    ThisDrawing.Plot.PlotToDevice
End Sub

 

 

Как его заставить их применить?

Изменено 3 июня, 2021 пользователем gizmo_zx

[Светлана Мирончик]

Тоже сталкивалась с таким предупреждением. У меня оно возникало, когда я пыталась добавить сразу несколько областей печати "Рамка" на лист. Если добавлять одну рамку методом setwindowtoplot, то все нормально работало. 

Такая разница в поведении этого кода в nanoCAD и AutoCAD скорее всего связана с доработкой в nanoCAD, позволяющей добавлять несколько областей печати "Рамка" на один лист. Вот пример на С# по областям печати, может поможет. На 21м nanoCAD работает

P.S. нужны библиотеки hostmgd.dll и ncauto.dll

 

SetPlotArea.cs

[gizmo_zx]

да спасибо. 

Это работает как надо.