Code:
Option ExplicitPublic Sub ZoomToSectionLine()
Dim oApp As Inventor.Application
Set oApp = ThisApplication
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = oApp.ActiveDocument
Dim oView As DrawingView
Do
Set oView = oApp.CommandManager.Pick(kDrawingViewFilter, "Schnittansicht auswählen... (Beenden mit ESC)")
If oView Is Nothing Then Exit Sub
If Not oView.ViewType = kSectionDrawingViewType Then MsgBox ("Die gewählte Ansicht ist keine Schnittansicht.")
Loop While Not oView.ViewType = kSectionDrawingViewType
Dim oSecView As SectionDrawingView
Set oSecView = oView
Dim oSecSketch As DrawingSketch
Set oSecSketch = oSecView.SectionLineSketch
Set oView = oSecSketch.Parent
Dim oParent As Object
Do
Set oParent = oView.Parent
Loop While Not TypeOf oParent Is Sheet
oParent.Activate
Dim oBox As Box2d
Set oBox = GetBox(oSecSketch)
Dim dWidth As Double
Dim dHeight As Double
dWidth = (oBox.MaxPoint.X - oBox.MinPoint.X + 1) '+1 nur damit die Differenz nie Null wird
dHeight = (oBox.MaxPoint.Y - oBox.MinPoint.Y + 1) '+1 nur damit die Differenz nie Null wird
Dim oLine As LineSegment2d
Set oLine = oApp.TransientGeometry.CreateLineSegment2d(oBox.MinPoint, oBox.MaxPoint)
Dim oCenter As Point2d
Set oCenter = oLine.MidPoint
Dim oCamera As Camera
Set oCamera = oApp.ActiveView.Camera
oCamera.Eye = oApp.TransientGeometry.CreatePoint(oCenter.X, oCenter.Y, oCamera.Eye.Z)
oCamera.Target = oApp.TransientGeometry.CreatePoint(oCenter.X, oCenter.Y, oCamera.Target.Z)
Call oCamera.SetExtents(dWidth, dHeight)
oCamera.Apply
End Sub
Private Function GetBox(ByVal oSecSketch As DrawingSketch) As Box2d
Set GetBox = ThisApplication.TransientGeometry.CreateBox2d
Dim i As Integer
Dim oEntity As SketchEntity
For Each oEntity In oSecSketch.SketchEntities
If oEntity.SketchOnly = False Then
If i = 0 Then
GetBox.MaxPoint = oSecSketch.SketchToSheetSpace(oEntity.RangeBox.MaxPoint)
GetBox.MinPoint = oSecSketch.SketchToSheetSpace(oEntity.RangeBox.MinPoint)
i = 1
Else
Call GetBox.Extend(oSecSketch.SketchToSheetSpace(oEntity.RangeBox.MinPoint))
Call GetBox.Extend(oSecSketch.SketchToSheetSpace(oEntity.RangeBox.MaxPoint))
End If
End If
Next
End Function
Foren auf CAD.de (alle Foren)
| 
