Thanks for your answer.
I already know how to get access to the active sketch directly. But i want to know the occurrence, where the active sketch is, in the assembly. I need an occurrence for creating a GeometryProxy to project an entity to the active sketch. Everything works fine with my code but it tooks time in large assemblies to find the occurence by searching down all the leaf occurrences.
Here is my Code to project all holes, with same diameter like the selected, to the active sketch. It's a bit cumbersome how i find the occurrence, but it works. I only want to know if there ist an easier way to determine the occurrence.
Sub Bohrungen_projizieren()
On Error GoTo Ende
Dim oSketch As PlanarSketch
Set oSketch = ThisApplication.ActiveEditObject
'Kreis greifen
Dim oCircleProxy As EdgeProxy
Set oCircleProxy = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Bohrungskreis auswählen")
'Skizze einen einzigartigen Namen geben
Dim SketchName As String
SketchName = oSketch.Name
oSketch.Name = "12345"
'Occurrence ermitteln
Dim oCircleOcc As Inventor.ComponentOccurrence
Set oCircleOcc = oCircleProxy.Parent.Parent
'Fläche von Kreis
Dim oCircleFaceProxy As FaceProxy
For Each oCircleFaceProxy In oCircleProxy.Faces
If oCircleFaceProxy.SurfaceType = kPlaneSurface Then Exit For
Next
Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmCompDef As AssemblyComponentDefinition
Set oAsmCompDef = oAsmDoc.ComponentDefinition
'Auf Alle LeafOccurrences zugreifen
Dim oLeafOccs As ComponentOccurrencesEnumerator
Set oLeafOccs = oAsmCompDef.Occurrences.AllLeafOccurrences
'Occurrence der Skizze finden
Dim oOcc As ComponentOccurrence
For Each oOcc In oLeafOccs
Dim oSketch2 As PlanarSketch
For Each oSketch2 In oOcc.Definition.Document.ComponentDefinition.Sketches
If oSketch.Name = oSketch2.Name Then
On Error GoTo 0
On Error Resume Next
oSketch2.ExitEdit
If Err.Number < 1 Then
oSketch2.Edit
Dim oNode As BrowserNode
Set oNode = oAsmDoc.BrowserPanes.ActivePane.GetBrowserNodeFromObject(oOcc)
oNode.DoSelect
If oNode.Expanded = True Then
oSketch2.Edit
GoTo AfterNext
End If
End If
End If
Next
Next
AfterNext:
oSketch.Name = SketchName
Dim oSketchProxy As PlanarSketchProxy
Call oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
Dim oEdgeProxy As EdgeProxy
For Each oEdgeProxy In oCircleFaceProxy.Edges
If oEdgeProxy.NativeObject.GeometryType = kCircleCurve Then
If Round(oEdgeProxy.NativeObject.Geometry.Radius, 5) = Round(oCircleProxy.NativeObject.Geometry.Radius, 5) Then
Dim oEntity As SketchEntity
Set oEntity = oSketchProxy.AddByProjectingEntity(oEdgeProxy)
oEntity.Reference = False
If TypeOf oEntity Is SketchCircle Then
oSketch.GeometricConstraints.AddGround (oEntity.CenterSketchPoint)
End If
Call oSketch.GeometricConstraints.AddGround(oEntity)
End If
End If
Next
ThisApplication.ActiveView.Update
Ende:
End Sub