GET THE COORDINATES OF A VIEWPORT

[hungkwunwah]

I have a Viewport  object located in layout , which is displaying a certain area of the model space, How to use VBA to get the lower left and upper right coordinates (x,y) of that area ?
Thanks in advance

[hungkwunwah]

I have a Viewport  object located in layout , which is displaying a certain area of the model space, How to use VBA to get the lower left and upper right coordinates (x,y) of that area ?
Thanks in advance

[Ed__Jobe · Accepted solution]

Here's my code that draws a polyline in model space at the extents of the viewport.

Public Sub VPExtentsBox()
    'call w/o arguments
    VPExtentsBox2
End Sub


Public Function VPExtentsBox2(Optional lwp As Variant, Optional CtrPnt As Variant)
    'draws a box in MS representing the extents of the current PS viewport
    '
    ' optional argument lwp returns the polyline
    ' optional argument CtrPnt returns the center of the box as a 3 element array of doubles
    
    Dim oPsVp As AcadPViewport
    Dim oBox As AcadLWPolyline
    Dim dPt1(0 To 2) As Double
    Dim dPt2(0 To 2) As Double
    Dim vCtrPt As Variant
    Dim vCtrPt1 As Variant
    Dim vMinPoint As Variant
    Dim vMaxPoint As Variant
    Dim BBpoints(0 To 9) As Double   'Bounding box points list
    
    If ThisDrawing.ActiveSpace = acPaperSpace Then 'first check for tilemode = 0
        If ThisDrawing.MSpace = True Then           'then make sure ms is active
            Set oPsVp = ThisDrawing.ActivePViewport
            vCtrPt = ThisDrawing.GetVariable("viewctr")
            VPCoords oPsVp, vMinPoint, vMaxPoint
            BBpoints(0) = vMinPoint(0): BBpoints(1) = vMinPoint(1)
            BBpoints(2) = vMaxPoint(0): BBpoints(3) = vMinPoint(1)
            BBpoints(4) = vMaxPoint(0): BBpoints(5) = vMaxPoint(1)
            BBpoints(6) = vMinPoint(0): BBpoints(7) = vMaxPoint(1)
            BBpoints(8) = vMinPoint(0): BBpoints(9) = vMinPoint(1)
            Set oBox = ThisDrawing.ModelSpace.AddLightWeightPolyline(BBpoints)
            vCtrPt1 = MidPoint(vMinPoint, vMaxPoint)
            dPt1(0) = vCtrPt1(0): dPt1(1) = vCtrPt1(1): dPt1(2) = vCtrPt1(2)
            dPt2(0) = vCtrPt(0): dPt2(1) = vCtrPt(1): dPt2(2) = vCtrPt(2)
            oBox.Move dPt1, dPt2
            If Not IsMissing(lwp) Then Set lwp = oBox
            If Not IsMissing(CtrPnt) Then
                CtrPnt = vCtrPt
            End If
        Else
            MsgBox "The active viewport must have ModelSpace active for this command to work.", vbExclamation, "Viewport Extents Box"
        End If
    Else
        MsgBox "You must be in paperspace with the active viewport in ModelSpace for this command to work.", vbExclamation, "Viewport Extents Box"
    End If

End Function
Public Sub VPCoords(vp As AcadPViewport, ll, ur)
    'Calculates the extents of a PaperSpace viewport in ModelSpace units
    'Arguments: An AcadPViewport entity and three variants.
    ' The two variants will be filled with the corner points.

    Dim min, MAX
    Dim oldMode As Boolean
    
    vp.GetBoundingBox min, MAX
    oldMode = ThisDrawing.MSpace
    ThisDrawing.MSpace = True
    ll = ThisDrawing.Utility.TranslateCoordinates(min, acPaperSpaceDCS, acDisplayDCS, False)
    ll = ThisDrawing.Utility.TranslateCoordinates(ll, acDisplayDCS, acUCS, False)
    ur = ThisDrawing.Utility.TranslateCoordinates(MAX, acPaperSpaceDCS, acDisplayDCS, False)
    ur = ThisDrawing.Utility.TranslateCoordinates(ur, acDisplayDCS, acUCS, False)
    ThisDrawing.MSpace = oldMode
    
End Sub

Public Function MidPoint(varPnt1 As Variant, varPnt2 As Variant) As Variant
  Dim varMidPnt As Variant
  varMidPnt = Array((varPnt1(0) + varPnt2(0)) / 2, _
  (varPnt1(1) + varPnt2(1)) / 2, (varPnt1(2) + varPnt2(2)) / 2)
  MidPoint = varMidPnt
End Function

[grobnik]

Hi @Ed__Jobe I'm looking at your above code, and I would like to have a your suggestion on how modify the viewport coordinates into active layout, instead draw a polyline around the active viewport.

I'll try to explain better:

I have several portion of a drawing in modelspace, at fixed distance, these will be viewed in several layouts each of one in a separate layout.

So as first point I'll copy the selected layout several times, but I have to move the viewport in order to get the next model space drawing portion.

I'll prepare a draft dwg and I'll share with you in case.

Thank you bye

[Ed__Jobe]

I'd like to help, but I've been under a deadline on this job. I don't know when I'll have time to help.