Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
chandra.shekar.g
in reply to: navbor

Hi @navbor,

 

 

I did some modifications to the code. try the following VBA code.

 

Sub Main()
    
    Dim oDef As ComponentDefinition
    Set oDef = ThisApplication.ActiveDocument.ComponentDefinition
    
    Dim copyDesign As DesignViewRepresentation
    Dim oView As DesignViewRepresentation
    Dim eye, target As Point
    Dim upVector As UnitVector

    Set copyDesign = oDef.RepresentationsManager.DesignViewRepresentations.Item("Bottom")
    Call copyDesign.Activate

    Dim currentView As View
    Set currentView = ThisApplication.ActiveView

    Dim currentCamera As Camera
    Set currentCamera = currentView.Camera

    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Set eye = tg.CreatePoint(currentCamera.eye.X, currentCamera.eye.Y, currentCamera.eye.Z)
    Set target = tg.CreatePoint(currentCamera.target.X, currentCamera.target.Y, currentCamera.target.Z)
    Set upVector = tg.CreateUnitVector(currentCamera.upVector.X, currentCamera.upVector.Y, currentCamera.upVector.Z)
    
    Dim width As Double
    Dim height As Double
    Call currentCamera.GetExtents(width, height)
    Call currentCamera.Fit
    
    Dim widthfit As Double
    Dim heightfit As Double
    Call currentCamera.GetExtents(widthfit, heightfit)

    Call currentCamera.SetExtents(width, height)
    
    Dim widthratio As Double
    Dim heightratio As Double

    widthratio = width / widthfit
    heightratio = height / heightfit

    Set oView = oDef.RepresentationsManager.DesignViewRepresentations.Item("Left")
    Call oView.Activate

    Dim docCamera As Camera
    Dim docView As View
    Set docView = ThisApplication.ActiveView

    Set docCamera = docView.Camera

    docCamera.eye = eye
    docCamera.upVector = upVector
    docCamera.target = target

    Call docCamera.Fit
    
    Dim Docwidth As Double
    Dim Docheight As Double
    Call docCamera.GetExtents(Docwidth, Docheight)
    Call docCamera.SetExtents(Docwidth * widthratio, Docheight * heightratio)

    Call docCamera.Apply

    Call docView.Update
    
End Sub

Please feel free to contact if there is any doubt.

 

If solves problem, click on "Accept as solution" / give a "Kudo"

 

Thanks and regards,


CHANDRA SHEKAR G
Developer Advocate
Autodesk Developer Network