[doctorraz]

Столкнулся с такой проблемой, если перед созданием
параметров печати в модели изменить вид или покрутить модель за видовой куб, а потом вернуть все на вид сверху, то код ниже некоректно определяет границы печати

Код:

[Выделить все]

Sub Отладка()
 ' This example allows the user to define an area in the current layout
    ' and displays a plot preview of the defined area.
    '
    ' * Note: You have to exit the
    ' plot preview before the VBA example will stop and control will be returned

    AppActivate ThisDrawing.Application.Caption

    Dim point1 As Variant, point2 As Variant
    
    ' Get first point in window
    point1 = ThisDrawing.Utility.GetPoint(, "Click the lower-left of the window to plot.")
    ReDim Preserve point1(0 To 1)   ' Change this to a 2D array by removing the Z position
    
    ' Get second point in window
    point2 = ThisDrawing.Utility.GetPoint(, "Click the upper-right of the window to plot.")
    ReDim Preserve point2(0 To 1)   ' Change this to a 2D array by removing the Z position

    ' Send information about window to current layout
    ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2
    ThisDrawing.ActiveLayout.PlotType = acWindow
    ThisDrawing.ActiveLayout.ConfigName = "DWG to PDF.pc3"
    ThisDrawing.Plot.DisplayPlotPreview acFullPreview
End Sub

если перед ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2 вставить

Код:

[Выделить все]

'******************************
'не очень красиво, а как должно быть
Set viewportObj = ThisDrawing.ActiveViewport
Set viewObj = ThisDrawing.Views.Add("Нормальный") 'то бы из шаблона AcadIso3D работало корректно
viewportObj.SetView viewObj
ThisDrawing.ActiveViewport = viewportObj
viewObj .delete
ThisDrawing.Regen True
'******************************

то границы определяет правильно, но естественно чертеж смещается.
собственно вопрос, как корректно установить Viewport для печати, что бы изображение в модели не смещалась?

[art_rrc]

Попробуйте добавить в код:

Код:

[Выделить все]

Dim newTarget(0 To 2) As Double
newTarget(0) = 0#: newTarget(1) = 0#: newTarget(2) = 0# 
viewportObj.Target = newTarget

[Александр Ривилис]

Координаты нужно задавать не в UCS (ПСК), и не в WCS (МСК), а в DCS. Подробнее здесь: http://adn-cis.org/forum/index.php?t...sg6253#msg6253

[doctorraz]

Сообщение от Александр Ривилис Координаты нужно задавать не в UCS (ПСК), и не в WCS (МСК), а в DCS. Подробнее здесь: http://adn-cis.org/forum/index.php?t...sg6253#msg6253

изучал справку по VBA, похоже DCS он не понимает (((
я так понял то невозможно получить у ActiveViewport текущие значения Target, center , Direction

.
только после сохранения чертежа, это следует из того, что если повернуть вид в модели и сохранить, а после сохранения вернуть вид обратно, то код

Код:

[Выделить все]

Set viewportObj = ThisDrawing.ActiveViewport
ThisDrawing.ActiveViewport=viewportObj

опять вернет прежний вид, как до сохранения. Поправьте меня если я не прав.
Собственно я пытаюсь сделать вот , что:

1. автоматически создаются параметры листа
2. создается файл dsd
3. публикую

естественно , чтобы это сделать корректно текущий Viewpor.Direction должен быть 0,0,1
и соответственно текущий Target должен быть либо 0, либо известен, но без сохранения его определить не получается
ThisDrawing.save то же не помогает
как повернуть вид или изменить эти значения, чтобы чертеж в модели не смещался относительно центра?

[Александр Ривилис]

Сообщение от doctorraz как повернуть вид или изменить эти значения, чтобы чертеж в модели не смещался относительно центра?

Командные методы не подходят? _ZOOM, _-PAN и т.д.?
Чтобы преобразовать точки из UCS или WCS (я не знаю в какой системе координат они у тебя) в DCS воспользуйся Utility.TranslateCoordinates

[art_rrc]

Вот просто из любопытства.. Вы пробовали перед печатью выставлять таргет в 0??

[doctorraz]

Сообщение от art_rrc Вот просто из любопытства.. Вы пробовали перед печатью выставлять таргет в 0??

конечно

Код:

[Выделить все]

Dim newTar(2) As Double
newTar(0) = 0
newTar(1) = 0
newTar(2) = 0
viewportObj.Target = newTar
ThisDrawing.ActiveViewport = viewportObj

так работает, но чертеж смещается
====================
вопрос открыт, как получить текущие Center, Direction, Target???
Очевидно, что свойства ActiveViewport это не текущие, а последние сохраненные

----- добавлено через ~2 ч. -----

Сообщение от Александр Ривилис Командные методы не подходят? _ZOOM, _-PAN и т.д.? Чтобы преобразовать точки из UCS или WCS (я не знаю в какой системе координат они у тебя) в DCS воспользуйся Utility.TranslateCoordinates

абсолютно то что надо!!!!

Код:

[Выделить все]

Dim point1 As Variant, point2 As Variant
    point1 = ThisDrawing.Utility.GetPoint(, "Click the lower-left of the window to plot.")
   point1 = ThisDrawing.Utility.TranslateCoordinates(point1, acWorld, acDisplayDCS, False)
   ReDim Preserve point1(0 To 1)
    point2 = ThisDrawing.Utility.GetPoint(, "Click the upper-right of the window to plot.")
    point2 = ThisDrawing.Utility.TranslateCoordinates(point2, acWorld, acDisplayDCS, False)
   ReDim Preserve point2(0 To 1)   ' Change this to a 2D array by removing the Z position

спасибо за придание нужного направления, все получилось
но пользователи порой такие затейники... зажмут шифт и двигают мышку с зажатым колесиком, потом удивляются, что чертежи на печать выходят косо (((
есть ли возможность если Direct не равен (0, 0, 1) развернуть модель в вид сверху не изменяя ее положения и размера(относительно центра экрана) (печать через публикацию)

[Александр Ривилис]

Сообщение от doctorraz есть ли возможность если Direct не равен (0, 0, 1) развернуть модель в вид сверху не изменяя ее положения и размера(относительно центра экрана) (печать через публикацию)

Ну как минимум нужно две операции. Сначала развернуть, потом подвинуть. Попробуй командные методы (_PLAN, _ZOOM, _PAN)

[doctorraz]

Сообщение от Александр Ривилис Ну как минимум нужно две операции. Сначала развернуть, потом подвинуть. Попробуй командные методы (_PLAN, _ZOOM, _PAN)

Спасибо все получилось!
Перед публикацией:

Код:

[Выделить все]

ThisDrawing.SendCommand "(command " & Chr(34) & _
			"_PLAN" & Chr(34) & _
			" " & Chr(34) & "т" & _
			Chr(34) & ")" & vbCr

Код:

[Выделить все]

После окончания публикации возвращаем как было:
ThisDrawing.SendCommand "(command " & Chr(34) & _
			"_ZOOM" & Chr(34) & _
			" " & Chr(34) & "п" & _
			Chr(34) & ")" & vbCr