Attribute VB_Name = "viewpoint_2D_01"
'#################### Please customize the header ####################
'Purpose:           View the selectet 2D Component in the mid of the screen
'                   Change the scale
'
'Start conditions:  CATDrawing is loaded
'
'
'Code, language of the user interface:
'                   CATIA V5 R18 64 bit Englisch
'
'Author:            R. Reuhl
'Date:              18.06.2012
'----------------------------------------------------------------
'History of Changes:
'- Version 00_1       19.06.2012,          Name,
'-              Changes ...
'- Version 00_2       ??.??.????           Name,
'-              Changes ...
'- Version 00_3       ??.??.????,          Name,
'-              Changes ...
'- Version 00_xx       ??.??.????,         Name,
'-              Changes ...
'- Version 00_xx       ??.??.????,         Name,
'-              Changes ...
'############################ End of Header #########################

Dim g_sMacroname As String
Dim g_sVersion As String
Option Explicit

Sub catmain()
'Macroname und Version for StatusBar
g_sMacroname = "Prototyp V5 2D Viewer "
g_sVersion = "Version 00_0"

'activate error messages
On Error Resume Next

'declare catia base objekt
Dim oCatia As Application
Set oCatia = CATIA

'message in statusbar
oCatia.StatusBar = g_sMacroname & ", " & g_sVersion

'Declare CATIA Documents
Dim oDocs As Documents
Set oDocs = oCatia.Documents

'declare active Document
Dim oDoc As Document
Set oDoc = oCatia.ActiveDocument

'declare Drawing Document
Dim oDoc_Draw As DrawingDocument
Set oDoc_Draw = oCatia.ActiveDocument

'declare Windows collection
Dim owinds As Windows
Set owinds = oCatia.Windows

'declare a single window
Dim owind As Window
Set owind = oCatia.ActiveWindow

'declare the viewers
Dim o2dviewers As Viewers
Set o2dviewers = owind.Viewers

On Error GoTo 0

'declare the viewer
Dim o2dviewer1 As Viewer
Set o2dviewer1 = o2dviewers.Item(1)

'declare the viewpoint
Dim o2dviewpoint1 'As Viewpoint2D no declaration in CATVBA
Set o2dviewpoint1 = o2dviewer1.Viewpoint2D

'Get the viewpoit origin
Dim a2dviewpoint_origin(1)
o2dviewpoint1.GetOrigin a2dviewpoint_origin
'a2dviewpoint_origin(0) = 0 ' mid of Screen
'a2dviewpoint_origin(1) = 0 ' mid of Screen
o2dviewer1.Update

'declare Selection anlegen
Dim osel As Object ' As Variant oder as Object in VBA und in CATSCRIPT As Selection
'Dim oSel As Selection ' As Variant oder as Object in VBA und in CATSCRIPT As Selection

Set osel = oDoc_Draw.Selection
osel.Clear
' filter for the selection of the 2D Component
Dim afilter(0)
'afilter(0) = "Spline2D"
'afilter(1) = "Line2D"
afilter(0) = "DrawingComponent"

'Selektion durchführen
Dim sStatus As String
Dim mbox As Long
Dim inextstatus As Integer
    
'mbox = MsgBox("Please select a 2D Domponent! ", 64, g_sMacroname & " // " & g_sVersion)
sStatus = osel.SelectElement2(afilter, "Please select one 2D Component!", False)

If sStatus <> "Normal" Then
        MsgBox "There was no selection!" '
        'Exit Sub
    Else
    End If
'zoom to the selected object
Call zoom_object(osel, oDoc_Draw, o2dviewer1, o2dviewpoint1)

'result box
mbox = MsgBox("The Macro is finished and will end!", 64, g_sMacroname & " // " & g_sVersion)

'reset Statusbar
Call emtystatusbar(oCatia)

End Sub


Sub emtystatusbar(oCatia)
'Infomeldung in Statuszeile
oCatia.StatusBar = ""

End Sub




Sub zoom_object(osel, oDoc_Draw, o2dviewer1, o2dviewpoint1)

'put selection to the object
Dim osel_object 'As HybridBody
Set osel_object = osel.Item(1)
osel.Clear
Dim osel_2DComp 'As String
Set osel_2DComp = osel_object.Value

'get the position of the selectes object
Dim apoint_object(1)
apoint_object(0) = 0 'x value in the View
apoint_object(1) = 0  'y value in the view
apoint_object(0) = osel_2DComp.X 'x value in the View
apoint_object(1) = osel_2DComp.Y  'y value in the view

'get the scale from the selected object
Dim scale_of_object As Double
scale_of_object = osel_2DComp.Scale2

'declare all sheets
Dim dsheets As DrawingSheets
Set dsheets = oDoc_Draw.Sheets

'declare the  active sheet
Dim dact_sheet As DrawingSheet
Set dact_sheet = dsheets.ActiveSheet

'declare the views
Dim dviews As DrawingViews
Set dviews = dact_sheet.Views
 
'declare the active View
Dim dview As DrawingView
Set dview = dviews.ActiveView

'get the view of the selected object
Dim sel_view As DrawingView
Set sel_view = osel_2DComp.Parent

osel.Add sel_view ' put the view in the selection
Set osel_object = osel.Item(1)
osel.Clear

'get the podition of the view
Dim apoint_view(1)
apoint_view(0) = 0 ' x value in the View
apoint_view(1) = 0 ' y value in the view
apoint_view(0) = osel_object.Value.X ' x value in the View
apoint_view(1) = osel_object.Value.Y ' y value in the view

'get the scale from the selected view
Dim scale_of_view As Double
scale_of_view = osel_object.Value.Scale2


'set the viewpint to the position of the selected object
Dim a2dviewpoint_origin(1)
o2dviewpoint1.GetOrigin a2dviewpoint_origin
a2dviewpoint_origin(0) = 0 ' mid of Screen
a2dviewpoint_origin(1) = 0 ' mid of Screen
a2dviewpoint_origin(0) = apoint_view(0) + apoint_object(0) * scale_of_view ' mid of Screen
a2dviewpoint_origin(1) = apoint_view(1) + apoint_object(1) * scale_of_view - 20 ' mid of Screen + 20 mm
o2dviewpoint1.PutOrigin a2dviewpoint_origin
o2dviewer1.Update

'zoomen
Dim Zoomfactor 'As Double
Zoomfactor = o2dviewpoint1.Zoom
'Zoomfactor = 0.00509 ' Fit all in for RAS DIN A3 Scale 1:1
'Zoomfactor = 0.0036 ' Fit all in for RAS DIN A2 Scale 1:1
'Zoomfactor = 0.0025 ' Fit all in for RAS DIN A1 Scale 1:1
'Zoomfactor = 0.0017 ' Fit all in for RAS DIN A0 Scale 1:1
'Zoomfactor = 0.00125 ' Fit all in for RAS DIN A0-17 Scale 1:1
Zoomfactor = 0.015 ' Din A0, Scale 1:1, View Scale 1:40
o2dviewpoint1.Zoom = Zoomfactor 'zoom on object
o2dviewer1.Update
End Sub