Перейти к содержанию

Рекомендуемые сообщения

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

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

GetPaperSize тоже.

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

 

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

 

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

 

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

Ссылка на сообщение
Поделиться на другие сайты

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", код инициализации луче размещать там.

Ссылка на сообщение
Поделиться на другие сайты

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

Ссылка на сообщение
Поделиться на другие сайты
  • 5 месяцев спустя...

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

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

 

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

Изменено пользователем horus
Ссылка на сообщение
Поделиться на другие сайты

День добрый, подскажите как использовать функцию 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

Изменено пользователем Robink
Ссылка на сообщение
Поделиться на другие сайты
  • 9 месяцев спустя...

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

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

Ссылка на сообщение
Поделиться на другие сайты
  • 6 месяцев спустя...

Вопрос.

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?!!

Ссылка на сообщение
Поделиться на другие сайты
  • 5 лет спустя...

Бодрого дня.

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

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

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

 

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

 

 

Ссылка на сообщение
Поделиться на другие сайты

Бодрого дня.

Код взял отсюда 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

Изменено пользователем gizmo_zx
Ссылка на сообщение
Поделиться на другие сайты
1 час назад, gizmo_zx сказал:

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

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

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

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

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

Ссылка на сообщение
Поделиться на другие сайты

Хотел по быстрому перевести на 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.

 

Ссылка на сообщение
Поделиться на другие сайты

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

Спойлер

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

Ссылка на сообщение
Поделиться на другие сайты

В чем проблема, я так и не понял. В 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 область печати все равно стоит в "экран"

Изменено пользователем 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

 

 

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

Изменено пользователем gizmo_zx
Ссылка на сообщение
Поделиться на другие сайты

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

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

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

 

SetPlotArea.cs

Ссылка на сообщение
Поделиться на другие сайты

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить в этой теме...

×   Вставлено с форматированием.   Восстановить форматирование

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

Загрузка...
  • Расскажите друзьям

    Нравится Официальный форум компании Нанософт? Расскажите друзьям!
×
×
  • Создать...