'--Inventor Application aktivieren bzw. öffnen
Dim objI As Inventor.Application
On Error Resume Next
Set objI = GetObject(, "Inventor.Application")
If Err.Number Then
    MsgBox "Es ist keine Baugruppe in Inventor geöffnet!"
    Exit Sub
End If
'--Baugruppe aktivieren
Dim oADoc As AssemblyDocument
On Error Resume Next
Set oADoc = objI.ActiveDocument
If Err.Number Then
    MsgBox "Es ist keine Baugruppe aktiv!"
    Exit Sub
End If

Dim oTG As TransientGeometry
Set oTG = objI.TransientGeometry
Dim oACompDef As AssemblyComponentDefinition
Set oACompDef = oADoc.ComponentDefinition

Dim oPane As BrowserPane
Set oPane = oADoc.BrowserPanes.Item("Modell")
Dim oTopNode As BrowserNode
Set oTopNode = oPane.TopNode
Dim oNode As BrowserNode
For Each oNode In oTopNode.BrowserNodes
    If oNode.BrowserNodeDefinition.Label = "Ursprung" Then
        oNode.BrowserNodes.Item(2).EnsureVisible
        oNode.BrowserNodes.Item(2).DoSelect
    End If
Next
Call SendKeys("s", True)
Call SendKeys("{F7}", True)
Call SendKeys("+M", True)

Dim varRadius As Double
varRadius = 3

Dim oPoint0 As Point2d
Set oPoint0 = oTG.CreatePoint2d(0#, 0#)
Dim oSketch As PlanarSketch
Set oSketch = objI.ActiveEditObject
Call oSketch.SketchCircles.AddByCenterRadius(oPoint0, 2#)
Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid
Call SendKeys("^z", True)
oADoc.Update
Call SendKeys("e", True)

Dim Tiefe As Variant
Tiefe = 20

Call SendKeys(Tiefe, True)
Call SendKeys("{enter}", True)