How to get the current views coords with VBA?

[klpocska]

I want to get the current views coords with VBA in model space. ( the windows corners coordinates)

 

what should i do ?

[SEANT]

This example routine may be helpful towards that goal. It gets the modelspace WCS points of the Lower Left and Upper Right corners of a paperspace viewport.

 

Sub PVPExtents()

Dim pvp As IAcadPViewport2
Dim dblCen() As Double
Dim dblscale As Double
Dim ent As AcadEntity
Dim varPt As Variant
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblLL(2) As Double
Dim dblUR(2) As Double
Dim varLL As Variant
Dim varUR As Variant
Dim dblVdir() As Double
Dim dblFactor As Double


  With ThisDrawing
  If .GetVariable("TILEMODE") = 1 Then
  .Utility.Prompt "Only applicable to Paperspace!" & vbCr
  Exit Sub
  End If
  ThisDrawing.MSpace = False
  
  .Utility.GetEntity ent, varPt, "Select a viewport: "
  
  If Not TypeOf ent Is AcadPViewport Then
     .Utility.Prompt "Not a viewport!" & vbCr
  Exit Sub
  End If
  
  Set pvp = ent
  dblVdir = Normalize(pvp.Direction)
  dblCen = pvp.Center
  dblWidth = pvp.Width / 2
  dblHeight = pvp.Height / 2
  dblscale = 1 / pvp.CustomScale
  .MSpace = True 'needed to translate coordinates
  .ActivePViewport = pvp

  dblLL(0) = dblCen(0) - dblWidth: dblLL(1) = dblCen(1) - dblHeight
  dblUR(0) = dblCen(0) + dblWidth: dblUR(1) = dblCen(1) + dblHeight
  varLL = .Utility.TranslateCoordinates(dblLL, acPaperSpaceDCS, acDisplayDCS, 0)
  varUR = .Utility.TranslateCoordinates(dblUR, acPaperSpaceDCS, acDisplayDCS, 0)
  
  varLL = .Utility.TranslateCoordinates(varLL, acDisplayDCS, acWorld, 0)
  varUR = .Utility.TranslateCoordinates(varUR, acDisplayDCS, acWorld, 0)
  
  'For 3d and Elevation views
  If Abs(dblVdir(0)) = 1 Then
     dblFactor = varLL(0) / dblVdir(0)
  ElseIf Abs(dblVdir(1)) = 1 Then
     dblFactor = varLL(1) / dblVdir(1)
  Else
     dblFactor = varLL(2) / dblVdir(2)
  End If
  
  varLL(0) = dblFactor * dblVdir(0) - varLL(0)
  varLL(1) = dblFactor * dblVdir(1) - varLL(1)
  varLL(2) = dblFactor * dblVdir(2) - varLL(2)
  
  varUR(0) = dblFactor * dblVdir(0) + varUR(0)
  varUR(1) = dblFactor * dblVdir(1) + varUR(1)
  varUR(2) = dblFactor * dblVdir(2) + varUR(2)
  
  .Utility.Prompt "Lower left is (" & varLL(0) & ", " & varLL(1) & ", " & varLL(2) & ") : "
  .Utility.Prompt "Upper right is (" & varUR(0) & ", " & varUR(1) & ", " & varUR(2) & ")" & vbCr
  
  .MSpace = False
  End With
End Sub


Function Normalize(varVect As Variant) As Double()
Dim dblMag As Double
  If Not IsVectZero(varVect, 6) Then
     dblMag = (varVect(0) ^ 2 + varVect(1) ^ 2 + varVect(2) ^ 2) ^ 0.5
     varVect(0) = varVect(0) / dblMag
     varVect(1) = varVect(1) / dblMag
     varVect(2) = varVect(2) / dblMag
  End If
  Normalize = varVect
End Function

Function IsVectZero(varVect As Variant, Optional lngPrecision As Long = 6) As Boolean
  IsVectZero = False
  If Round(varVect(2), lngPrecision) <> 0# Then Exit Function
  If Round(varVect(1), lngPrecision) <> 0# Then Exit Function
  If Round(varVect(0), lngPrecision) <> 0# Then Exit Function
  IsVectZero = True
End Function

[klpocska]

Thx, but it quite helpful for me. I use only the model space.

 

 

Example:

 

The windows corners coords:

left upper: 854000.0000,452250.0000

Left lower: 854000.0000,452000.0000

Right upper: 854375.0000,452250.0000

Right lower: 854375.0000,452000.0000

(This is my model spaces window)

 

How can I get this coords?

 

Other problem is how to get the coords when I move or resize the drawing window, or if I change the zoom level or scrolling?

[SEANT]

I see. This type of question is more often asked about Pviewports . . . .I made the wrong assumption.

 

For standard views, maybe this example would be helpful:

 

Sub viewExtents()

Dim dblCen() As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblLL(1) As Double
Dim dblUR(1) As Double
Dim dblFactor As Double
Dim varTarg As Variant
Dim varSrnSiz As Variant

  With ThisDrawing
  If .GetVariable("TILEMODE") = 0 Then
  .Utility.Prompt "Only applicable to Modelspace!" & vbCr
  Exit Sub
  End If
  

  varTarg = .GetVariable("VIEWCTR")
  varSrnSiz = .GetVariable("SCREENSIZE")
  dblHeight = .GetVariable("VIEWSIZE")
  dblFactor = varSrnSiz(0) / varSrnSiz(1)
  dblWidth = dblHeight * dblFactor

  
  
  dblLL(0) = Round(varTarg(0) - (dblWidth / 2), 4)
  dblLL(1) = Round(varTarg(1) - (dblHeight / 2), 4)
  dblUR(0) = Round(varTarg(0) + (dblWidth / 2), 4)
  dblUR(1) = Round(varTarg(1) + (dblHeight / 2), 4)

  
  .Utility.Prompt "Lower left is (" & dblLL(0) & ", " & dblLL(1) & ") : " _
     & "Upper right is (" & dblUR(0) & ", " & dblUR(1) & ")" & vbLf
  End With
End Sub

[klpocska]

Thx , It was very useful for me.

[klpocska]

I see. This type of question is more often asked about Pviewports . . . .I made the wrong assumption.

 

For standard views, maybe this example would be helpful:

 

Sub viewExtents()

Dim dblCen() As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblLL(1) As Double
Dim dblUR(1) As Double
Dim dblFactor As Double
Dim varTarg As Variant
Dim varSrnSiz As Variant

  With ThisDrawing
  If .GetVariable("TILEMODE") = 0 Then
  .Utility.Prompt "Only applicable to Modelspace!" & vbCr
  Exit Sub
  End If
  

  varTarg = .GetVariable("VIEWCTR")
  varSrnSiz = .GetVariable("SCREENSIZE")
  dblHeight = .GetVariable("VIEWSIZE")
  dblFactor = varSrnSiz(0) / varSrnSiz(1)
  dblWidth = dblHeight * dblFactor

  
  
  dblLL(0) = Round(varTarg(0) - (dblWidth / 2), 4)
  dblLL(1) = Round(varTarg(1) - (dblHeight / 2), 4)
  dblUR(0) = Round(varTarg(0) + (dblWidth / 2), 4)
  dblUR(1) = Round(varTarg(1) + (dblHeight / 2), 4)

  
  .Utility.Prompt "Lower left is (" & dblLL(0) & ", " & dblLL(1) & ") : " _
     & "Upper right is (" & dblUR(0) & ", " & dblUR(1) & ")" & vbLf
  End With
End Sub

 

How can run automatically this macro when I move or resize the drawing window, or if I change the zoom level or scrolling?

[SEANT]

Much of the information pertinent to views is contained within AutoCAD System Variables. Hooking into the appropriate Application. SysVarChanged Event would give proper notification that a view had changed, thus allowing the procedure to respond accordingly.