VBA code for zooming to area.

[bwang-tecoustics]

On an Inventor drawing mode, there is a zoom window icon which let you zoom to a specific area. If there a VBA code for the same function?

[wayne.brill]

Hi,

Here is a VBA example that uses the camera of the active view. When run the zoom should change to the center of the sheet with the extents set to 40x40.

Public Sub Zoom_With_Camera()
    
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
       
    Dim sheetWidth As Double
    sheetWidth = oSheet.Width
    
    Dim sheetHeight As Double
    sheetHeight = oSheet.Height
   
    Dim oCamera As Camera
    Set oCamera = ThisApplication.ActiveView.Camera
 
   Dim NewTargePnt As point
   Set NewTargePnt = ThisApplication.TransientGeometry.CreatePoint(sheetWidth / 2, sheetHeight / 2, 0)
   oCamera.Target = NewTargePnt

   Call oCamera.SetExtents(40, 40)
   oCamera.Apply

End Sub

These posts may be of interest:

ttp://modthemachine.typepad.com/my_weblog/2013/09/working-with-cameras-part-1.html
http://adndevblog.typepad.com/manufacturing/2014/11/set-drawing-view-back-to-normal.html

Thanks,

Wayne

[bwang-tecoustics]

Thx. But the code will also change my drawing view displace area. Is there a way not change the drawing view but just zoom into an area on the sheet?

[wayne.brill]

Hi,

I am not sure what you mean by "change my drawing view displace area". When I run that VBA code I see it zooming to a different area on the sheet. The NewTargePoint  becomes the center of what I see on the sheet. If I comment out the call to .SetExtents the zoom changes to that location but the size of the sheet I am seeing stays the same.

I believe you would need to get the points of the area you want to zoom to and then use .SetExtents with those points.

If this does not help maybe you could upload some screenshots to help explain your requirement.

Thanks,

Wayne

[wayne.brill · Accepted solution]

Hi,

I see now that to get consistent results the Eye and the upvector also need to be set. Here is another example. Does this solve the problem?

Public Sub Zoom_With_Camera()
    
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
       
    Dim sheetWidth As Double
    sheetWidth = oSheet.Width
    
    Dim sheetHeight As Double
    sheetHeight = oSheet.Height
   
    Dim oCamera As Camera
    Set oCamera = ThisApplication.ActiveView.Camera
    'Set oCamera = oDoc.Views(1).Camera

    Dim NewTargetPnt As point
    Set NewTargetPnt = ThisApplication.TransientGeometry.CreatePoint(sheetWidth / 2, sheetHeight / 2, 0)
    oCamera.Target = NewTargetPnt

    Dim newEyePnt As point
    Set newEyePnt = ThisApplication.TransientGeometry.CreatePoint(sheetWidth / 2, sheetHeight / 2, 1)
    oCamera.Eye = newEyePnt
    
    oCamera.UpVector = ThisApplication.TransientGeometry.CreateUnitVector(0, 1, 0)
  
  ' Call oCamera.SetExtents(40, 40)
   oCamera.Apply

End Sub

Thanks,

Wayne

[bwang-tecoustics]

The last one works perfect. The drawing view on the sheet won't be affected. Thx alot.