Determine the Occurrence of a active Sketch in an Assembly

Determine the Occurrence of a active Sketch in an Assembly

dg2405
Advocate Advocate
475 Views
3 Replies
Message 1 of 4

Determine the Occurrence of a active Sketch in an Assembly

dg2405
Advocate
Advocate

What is the easies/fastest way to determine the occurrence of an active sketch in an assembly?

 

My method till now searches alle the leafoccurrences down to the sketch. In big assemblies it takes to long. So is there another way to do this?

0 Likes
476 Views
3 Replies
Replies (3)
Message 2 of 4

Owner2229
Advisor
Advisor

Hi, you can return the active object directly:

 

Dim oSketch As PlanarSketch
If Typeof ThisApplication.ActiveEditObject Is Sketch Then
    oSketch = ThisApplication.ActiveEditObject
    MsgBox(oSketch.Name & " is the active Sketch")
End If

 

Or do you mean parts? Or sketches from parts?

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
0 Likes
Message 3 of 4

dg2405
Advocate
Advocate

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
0 Likes
Message 4 of 4

Owner2229
Advisor
Advisor

Well, did you try to get the active-edit object (the sketch) and then it's parent (.parent)?

 

I'm not sure if it'll return occurrence or document, so you'll have to test it out.

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
0 Likes