iLogic-Development/COPY_CAMERA_TO_OPEN_DOCUMENTS.ILOGICVB at main · TeeVar/iLogic-Development · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Sub Main()

'Ask for zoom and image save options
zoomfit = InputRadioBox("Zoom Options", "Copy with same Zoom Ratio", _
"Copy with same Zoom", booleanParam, Title := "Copy Active View to open Docs")


image = InputRadioBox("Create Images in C:\Temp",  _
"Create Images", "Don't create Images", booleanParam, Title := "Copy Active View to open Docs")


Dim oInventor As Application
Dim oDoc, Doc As Document

Dim oView, DocView As View
Dim oCamera, DocCamera  As Camera
Dim eye, target As Point
Dim upvector As UnitVector

'Get the active document and the active Camera Position
oInventor = ThisApplication
oDoc = oInventor.ActiveDocument
oView = oInventor.ActiveView
oCamera = oView.Camera

'Prepare Transient Geometry and copy Camera properties
Dim tg As TransientGeometry
tg = oInventor.TransientGeometry
eye = tg.CreatePoint(oCamera.eye.X, oCamera.eye.Y, oCamera.eye.Z)
target = tg.CreatePoint(oCamera.target.X, oCamera.target.Y, oCamera.target.Z)
upvector = tg.CreateUnitVector(oCamera.upvector.X, oCamera.upvector.Y, oCamera.upvector.Z)

Dim width As Double
Dim height As Double
Call oCamera.GetExtents(width, height)


'If Zoom Ratio then perform a Zoom All to calculate the actual Window Ratio
If Zoomfit = True Then
    oCamera.Fit

    Dim widthfit As Double
    Dim heightfit As Double
    Call oCamera.GetExtents(widthfit, heightfit)

    Call oCamera.SetExtents(width, height)

    widthratio = width / widthfit
    heightratio = height / heightfit
End If

'if Image saving is asked save in C:\Temp + Display Name of the file. Error if display name contains special character
If Image = True Then
	Try
	'Switch Off 3D Indicator
	oInventor.DisplayOptions.Show3DIndicator = False

    Call oView.SaveAsBitmap("C:\Temp\" & oDoc.DisplayName & ".jpg", 1400, 825)
	Catch
	MsgBox ("Invalid Name. Impossible to save Image from"  & oDoc.DisplayName )
	Finally
	'Switch Off 3D Indicator
	oInventor.DisplayOptions.Show3DIndicator = True

	End Try

End If


'Scan through all the opened documents except the active one and the drawings
For Each Doc In oInventor.Documents.VisibleDocuments
    If Doc.FullFileName <> oDoc.FullFileName And (Doc.DocumentType = kAssemblyDocumentObject Or kPartDocumentObject) Then

        Doc.Activate
        DocView = oInventor.ActiveView
        DocCamera = DocView.Camera

        'Set camera perspective to apply camera settings
        'DocCamera.Perspective = True

        DocCamera.eye = eye
        DocCamera.target = target
        DocCamera.upvector = upvector


        'If Zoom Ratio then perform apply zoom ratio
        If Zoomfit = True Then
            DocCamera.Fit

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

            DocCamera.Apply
            DocView.Update

		Else

		Call DocCamera.SetExtents(width, height)

        DocCamera.Apply
        DocView.Update

        End If


        'Enable Autosave Camera, not possible if view is set to master
        If Doc.DocumentType = kAssemblyDocumentObject Then
            Dim asm As AssemblyDocument
			Try
            asm = Doc
            asm.ComponentDefinition.RepresentationsManager.ActiveDesignViewRepresentation.AutoSaveCamera = True
        	Catch
			End Try
		ElseIf Doc.DocumentType = kPartDocumentObject Then
			Try
            Dim prt As PartDocument
            prt = Doc
            prt.ComponentDefinition.RepresentationsManager.ActiveDesignViewRepresentation.AutoSaveCamera = True
        	Catch
			End Try
		End If

        'if Image saving is asked save in C:\Temp + Display Name of the file. Error if display name contains special character
        If Image = True Then
			Try
			'Switch Off 3D Indicator
			oInventor.DisplayOptions.Show3DIndicator = False

        	Call DocView.SaveAsBitmap("C:\Temp\" & Doc.DisplayName & ".jpg", 1400, 825)
		   	Catch
			MsgBox ("Invalid Name. Impossible to save Image from"  & Doc.DisplayName )
			Finally
			'Switch Off 3D Indicator
			oInventor.DisplayOptions.Show3DIndicator = True
			End Try
        End If

    End If
Next

oDoc.Activate

End Sub