Hello
So we'll try to fit your needs. 🙂
To test:
- SAVE your work
- open your assembly, your drawing and close all other unused files
- run the AddOrientedBaseViews Sub
- select the part occurrence in your assembly when prompted
- wait until finished
The WorkPlanes must be named "ViewPlane1", "ViewPlane2", "ViewPlane3" and so on. The macro looks for the first 9 chars in name. We need this to filter out work planes used for other things. I've marked the position in code if you would like to use another name. Also adapt the number of chars in the same line to your name.
Option Explicit
Private myAssDoc As AssemblyDocument
Private myDrawDoc As DrawingDocument
Private oAssView As View
Private oDrawView As View
Public Sub AddOrientedBaseViews()
Dim oApp As Inventor.Application
Set oApp = ThisApplication
If oApp.Documents.Count = 0 Then
Call MsgBox("Need a drawing and the assembly open.", vbCritical)
Exit Sub
End If
If oApp.Views.Count > 2 Then
Call MsgBox("Please have only your drawing and the assembly open.", vbCritical)
Exit Sub
End If
If Not oApp.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Call MsgBox("Need a drawing document active.", vbCritical)
Exit Sub
End If
Dim oView As View
For Each oView In oApp.Views
If oView.Document.DocumentType = kAssemblyDocumentObject Then
Set myAssDoc = oView.Document
Set oAssView = oView
Call oAssView.Activate
ElseIf oView.Document.DocumentType = kDrawingDocumentObject Then
Set oDrawView = oView
Set myDrawDoc = oView.Document
End If
Next
Call RotateAssy
MsgBox "Done"
End Sub
Private Sub RotateAssy()
Dim oAssDoc As AssemblyDocument
Set oAssDoc = myAssDoc
Dim oCompOcc As ComponentOccurrence
Set oCompOcc = ThisApplication.CommandManager.Pick(kAssemblyLeafOccurrenceFilter, "Select the Part with ViewPlanes.")
If oCompOcc.DefinitionDocumentType = kPartDocumentObject Then
Call oDrawView.Activate
Call ProcessOccs(oCompOcc)
End If
End Sub
Private Sub ProcessOccs(ByVal oCompOcc As ComponentOccurrence)
'Ignore pattern elements
If oCompOcc.IsPatternElement = True Then Exit Sub
Dim oCompDef As PartComponentDefinition
Set oCompDef = oCompOcc.Definition
Dim iPosIndex As Integer
Dim oWorkPlane As WorkPlane
For Each oWorkPlane In oCompDef.WorkPlanes
If Left(oWorkPlane.Name, 9) = "ViewPlane" Then '<---------------------------------process only named work planes where first 9 chars are "ViewPlane"
Dim oWorkPlaneProxy As WorkPlaneProxy
Call oCompOcc.CreateGeometryProxy(oWorkPlane, oWorkPlaneProxy)
If Not oWorkPlaneProxy Is Nothing Then
Dim oCamera As camera
Set oCamera = PlaneToFront(oWorkPlaneProxy)
If Not oCamera Is Nothing Then
Call AddOrientedBaseView(oCamera, oWorkPlane.Name, iPosIndex)
If iPosIndex < 5 Then
iPosIndex = iPosIndex + 1
End If
End If
End If
End If
Next
End Sub
Private Function PlaneToFront(ByVal oWorkPlaneProxy As WorkPlaneProxy) As camera
Dim oWorkPlaneNormal As UnitVector
Set oWorkPlaneNormal = oWorkPlaneProxy.Plane.Normal
Dim oOrigin As Point
Dim oXAxis As UnitVector
Dim oYAxis As UnitVector
Call oWorkPlaneProxy.GetPosition(oOrigin, oXAxis, oYAxis)
Dim oCamera As camera
Set oCamera = oAssView.camera
oCamera.Target = oOrigin
Dim oEye As Point
Set oEye = oCamera.Target
Call oEye.TranslateBy(oWorkPlaneNormal.AsVector)
oCamera.Eye = oEye
Call oCamera.ApplyWithoutTransition
'Dim i As Integer
'For i = 1 To 100
' Sleep 10
' DoEvents
'Next
Set PlaneToFront = oCamera
End Function
Private Sub AddOrientedBaseView(ByVal oCamera As camera, ByVal sWorkPlaneName As String, ByVal iPosIndex As Integer)
Dim oApp As Inventor.Application
Set oApp = ThisApplication
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = myDrawDoc
Dim oAssDoc As AssemblyDocument
Set oAssDoc = myAssDoc
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim aPos(5, 1) As Integer
aPos(0, 0) = 1
aPos(0, 1) = 3
aPos(1, 0) = 3
aPos(1, 1) = 3
aPos(2, 0) = 5
aPos(2, 1) = 3
aPos(3, 0) = 1
aPos(3, 1) = 1
aPos(4, 0) = 3
aPos(4, 1) = 1
aPos(5, 0) = 5
aPos(5, 1) = 1
Dim oPos As Point2d
Set oPos = oApp.TransientGeometry.CreatePoint2d(oSheet.Width / 6 * aPos(iPosIndex, 0), oSheet.Height / 4 * aPos(iPosIndex, 1))
Dim oScale As Double
oScale = 0.2 '<---------------------------------------------------------------------------Scale factor 1:5
Dim oDrawView As DrawingView
Set oDrawView = oSheet.DrawingViews.AddBaseView(oAssDoc, oPos, oScale, kArbitraryViewOrientation, kHiddenLineRemovedDrawingViewStyle, , oCamera)
oDrawView.Label.FormattedText = sWorkPlaneName
oDrawView.ShowLabel = True
End Sub
R. Krieg
RKW Solutions
www.rkw-solutions.com
