[Overl0rd555]

Есть потребность в создании видовых экранов для дальнейшего создание листов и расположения на них видовых экранов и последующей печати
делаю на VBA из под Excel

Код:

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

Dim VPCoord(0 To 2) As Double
Dim xView As AcadView
Dim startPoint As Variant
Dim objText As AcadEntity
Dim get_text As String

Const maxY As Integer = 287
Const maxX As Integer = 395


    AutoCAD.Application.ActiveDocument.Utility.GetEntity objText, varPnt, vbCr & "Выбрать название видового экрана"
    get_text = objText.TextString

    startPoint = AutoCAD.Application.ActiveDocument.Utility.GetPoint(, "Выбрать нижнюю правую точку")

    VPCoord(0) = startPoint(0) + maxX / 2
    VPCoord(1) = startPoint(1) + maxY / 2
    VPCoord(2) = 0

    Set xView = AutoCAD.Application.ActiveDocument.Views.Add(get_text)

    xView.Center(0) = startPoint(0) + maxX / 2
    xView.Center(1) = startPoint(1) + maxY / 2
    ' xView.Target = AutoCAD.Application.ActiveDocument.Utility.TranslateCoordinates(VPCoord, acWorld, acDisplayDCS, false)
    xView.Target = VPCoord
    xView.Width = maxX
    xView.Height = maxY

вроде бы работает, но есть НО
1. размеры совпадают, а координаты плавают почему-то относительно позиций и масштаба экрана и не попадают на нужное место
2. xView.Center - изменение значений не влияет на результат
3. xView.Target = AutoCAD.Application.ActiveDocument.Utility.TranslateCoordinates(VPCoord, acWorld, acDisplayDCS, false) == тоже не помогает
4. в диспетчере видов нет маленькой картинки, нет данных Снимок слоев=НЕТ, Визуальный стиль=НЕТ, ПСК=нет

2 дня лопачу форум и хелпы, но пока не получается (сразу ответ на вопрос посмотреть там или там) или чего-то непонимаю
как заставить попадать на координаты и добавить картинку и другие данные в видовой экран?

[Boxa]

Сообщение от Overl0rd555 AcadView - это видовой экран в "Виды моделей" пространства модели AcadViewport - это именованный видовой экран AcadPViewport - это видовой экран пространства листа

Сообщение от Alexeipost Пытаюсь подвинуть видовой экран в пространстве листа, но не получается...

но в Вашем коде Вы меняете координаты у активного именованного видового экрана (AcadViewport) ... Вы точно ничего не перепутали?

[Alexeipost]

Сообщение от Boxa но в Вашем коде Вы меняете координаты у активного именованного видового экрана (AcadViewport) ... Вы точно ничего не перепутали?

У меня есть чертежи в модели. Они там расположены по сетке. Т.е. левый верхний угол второго чертежа находится на 290 "точек" правее чем левый верхний угол первого чертежа.
В пространстве листа есть видовой экран. Он настроен на первый чертеж в модели.
Я копирую лист, выделяю видовой экран и за правую верхнюю ручку растягиваю видовой экран вправо на 290 вправо, далее на такое же расстояние растягиваю левую верхнюю ручку. Потом перемещаю видовой экран обратно на 290. И вуаля! Он у меня точно в области печати (которая установлена ранее).
Вот что мне надо

[Boxa]

Как пример, без всяких проверок и поправок, только для демонстрации в какую сторону копать:

Код:

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

Sub ViewP()
    Dim vportObj As AcadPaperSpace
    Set vportObj = ThisDrawing.PaperSpace
    For i = 1 To vportObj.Count
         If TypeOf vportObj(i) Is AcadPViewport Then
            Dim vp As AcadPViewport
            
            Set vp = vportObj(i)
            Dim newCenterPt(0 To 2) As Double
            newCenterPt(0) = vp.Center(0) + 290
            newCenterPt(1) = vp.Center(1)
            newCenterPt(2) = vp.Center(2)
            
            vp.Center = newCenterPt
            vp.Update
        
            Exit For
        End If
    Next
End Sub