project proxy geometry in assembly

[Covello_O]

Hy All

Again I need some help.

In assembly I want to create a new sketch that projects only the studs (and not any hole) that are on the sheet and the inner edges of the sheet too. Then I would export it as a dxf.

I saw here in the forum that this can be achieved with the CreateGeometryProxy or AddProjectingEntity

but I couldn’t figure out how because I lack the necessary knowledge.

Any help will be very appreciated many thanks

I've found this code but here I have to select the entity to project manually

 Dim oAssemDoc As AssemblyDocument = ThisApplication.ActiveDocument
 Dim oAssemDef As AssemblyComponentDefinition = oAssemDoc.ComponentDefinition
 
 'Select face on part document
 Dim oFace As Object = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select face on part for new sketch")
 If oFace Is Nothing Then Exit Sub

 Dim oOcc As ComponentOccurrence = oFace.ContainingOccurrence
 oOcc.Edit

'Active part document within an open assembly
 Dim oPartDoc As PartDocument = ThisApplication.ActiveEditDocument 
 Dim oPartDef As PartComponentDefinition = oPartDoc.ComponentDefinition

 Dim oSketch As PlanarSketch = oPartDef.Sketches.Add(oFace.NativeObject)
 oSketch.Edit
 oSketch.Name = "ocSketch"
 'oSketch.ExitEdit
 ' Dim oPointProxy As ObjectTypeEnum = oSketch.SketchPoints
 Dim oEntity As Object = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Select entity to project") 
'Dim oEntity As Object = oFace
 If oEntity Is Nothing Then Exit Sub
 Dim oEntityOcc As ComponentOccurrence = oEntity.ContainingOccurrence
 oEntityOcc.CreateGeometryProxy(oEntity, oEntityProxy)
 oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
 oSketchProxy.AddByProjectingEntity(oEntityProxy)

[nstevelmans · Accepted solution]

Hi, maybe this can be a start.

Select a face in the  assembly.

Select an Occurrence in the assy (Only works with cylinder studs)

 
 
 Sub main
 Dim oAssyDoc As AssemblyDocument = ThisApplication.ActiveDocument
        Dim oAsmCompDef As AssemblyComponentDefinition = oAssyDoc.ComponentDefinition
        'Select face on part document
        Dim oFace As Object = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select face on part for new sketch")
        If oFace Is Nothing Then Exit Sub
        Dim oSketch As PlanarSketch
        Dim oSketches As PlanarSketches = oAsmCompDef.Sketches
        oSketch = oSketches.Add(oFace)
        Dim oOccMaster As ComponentOccurrence = oFace.ContainingOccurrence
        GetEntitiesEdgeLoop(oOccMaster, oFace, oSketch)

        Dim oCC As ComponentOccurrence = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select occurrance")
        If oCC Is Nothing Then Exit Sub
        Dim oIntnameCheck As String = oCC.Definition.Document.internalname
        ' Call the function that does the recursion.
        TraverseAssembly(oAssyDoc.ComponentDefinition.Occurrences, 1, oSketch, oIntnameCheck)
        oAssyDoc.Update()
		
	End Sub
	
	
	
	
	   Private Sub GetEntitiesEdgeLoop(Occ As ComponentOccurrence, oFace As Face, oSketch As PlanarSketch)
        Dim projectEdges As Edges
        For Each oEdgeLoop As EdgeLoop In oFace.EdgeLoops
            If oEdgeLoop.IsOuterEdgeLoop = True Then
                projectEdges = oEdgeLoop.Edges
                For Each edge In projectEdges
                    Dim oEdgepProxy As Object
                    Occ.CreateGeometryProxy(Edge, oEdgepProxy)
                    oSketch.AddByProjectingEntity(Edge)
                Next
                Exit For
            End If
        Next
    End Sub
	
	
	
	
	
	
	 Private Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer, oSketch As PlanarSketch, InterNameCheck As String)
        ' Iterate through all of the occurrence in this collection.  This
        ' represents the occurrences at the top level of an assembly.
        Dim oOcc As ComponentOccurrence
        For Each oOcc In Occurrences
            ' Print the name of the current occurrence.
            If oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then
                Dim oOccInterName As String = oOcc.Definition.Document.internalname
                If oOccInterName = InterNameCheck Then
                    GetEntities(oOcc, oSketch)
                End If
            End If
            ' Check to see if this occurrence represents a subassembly
            ' and recursively call this function to traverse through it.
            If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
                TraverseAssembly(oOcc.SubOccurrences, Level + 1, oSketch, InterNameCheck)
            End If
        Next
    End Sub
	
	
	
	  Private Sub GetEntities(Occ As ComponentOccurrence, oSketch As PlanarSketch)
        ' Because we need the sketch line in the context of the assembly
        ' we need to create a proxy for the sketch line. The proxy
        ' represents the sketch line in the context of the assembly.
        Dim oEdge As Edge = Nothing
        Dim oPartCompdef As PartComponentDefinition = Occ.Definition
        Dim oSurfacebody As SurfaceBody = oPartCompdef.SurfaceBodies.Item(1)
        oEdge = oSurfacebody.Edges.Item(1)
        Dim oEdgeproxy As Object
        Occ.CreateGeometryProxy(oEdge, oEdgeproxy)
        oSketch.AddByProjectingEntity(oEdgeproxy)
    End Sub
	
	

If a response answers your question, please use  ACCEPT SOLUTION  to assist other users later.

Also be generous with Likes!  Thank you and enjoy!

 

[Covello_O]

Hi

Thank you very much for taking the time to write this code of lines.

It works perfectly. And also thanks for commenting it.

I can definitely start with it

The only thing that I would like to change is that if the occ has another name, for instance M6x15 and M6x20 than I have to make two sketches.

So instead to pick an occurence manualy its maybe better to ask the user with an InputBox that looks for a  string in the occ name and projects all occ with that name to the scatch?

What would you suggest?

[nstevelmans]

Hi, I reworked the code a little

1 create a name for the sketch (same name as the part)

1. loop trough all sketches a see if the sketch exists (no new sketch will be created, and you can run the code multiple times)
2. create a loop for selecting multiple occurrences (with escape you can abort)

Sub main
	    Dim oAssyDoc As AssemblyDocument = ThisApplication.ActiveDocument
        Dim oAsmCompDef As AssemblyComponentDefinition = oAssyDoc.ComponentDefinition
        'Select face on part document
        Dim oFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Select face on part for new sketch")
        If oFace Is Nothing Then Exit Sub
        Dim oSketch As PlanarSketch
        Dim oSketches As PlanarSketches = oAsmCompDef.Sketches
        Dim oPartDoc As PartDocument = oFace.Parent.Parent.definition.document
        Dim oPartDocName As String = oPartDoc.DisplayName
        Dim oCharCount As Integer = Strings.Len(oPartDocName)
        Dim oNewName As String = Strings.Left(oPartDocName, (oCharCount - 4))
        If oSketches.Count > 0 Then
            For Each oSketch In oSketches
                If oSketch.Name = oNewName Then
                    oSketch = oSketch
                Else
                    oSketch = oSketches.Add(oFace)
                    oSketch.Name = oNewName
                End If
            Next
        Else
            oSketch = oSketches.Add(oFace)
            oSketch.Name = oNewName
        End If
        Dim oOccMaster As ComponentOccurrence = oFace.ContainingOccurrence
        GetEntitiesEdgeLoop(oOccMaster, oFace, oSketch)
        Dim oCC As ComponentOccurrence
        Do
            oCC = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select occurrance")
            If Not oCC Is Nothing Then
                Dim oIntnameCheck As String = oCC.Definition.Document.internalname
                ' Call the function that does the recursion.
                TraverseAssembly(oAssyDoc.ComponentDefinition.Occurrences, 1, oSketch, oIntnameCheck)
            End If
        Loop While Not oCC Is Nothing
        oAssyDoc.Update()
	End Sub
	
	  Private Sub GetEntitiesEdgeLoop(Occ As ComponentOccurrence, oFace As Face, oSketch As PlanarSketch)
        Dim projectEdges As Edges
        For Each oEdgeLoop As EdgeLoop In oFace.EdgeLoops
            If oEdgeLoop.IsOuterEdgeLoop = True Then
                projectEdges = oEdgeLoop.Edges
                For Each edge In projectEdges
                    Dim oEdgepProxy As Object
                    Occ.CreateGeometryProxy(Edge, oEdgepProxy)
                    oSketch.AddByProjectingEntity(Edge)
                Next
                Exit For
            End If
        Next
    End Sub
	
	 Private Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer, oSketch As PlanarSketch, InterNameCheck As String)
        ' Iterate through all of the occurrence in this collection.  This
        ' represents the occurrences at the top level of an assembly.
        Dim oOcc As ComponentOccurrence
        For Each oOcc In Occurrences
            ' Print the name of the current occurrence.
            If oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then
                Dim oOccInterName As String = oOcc.Definition.Document.internalname
                If oOccInterName = InterNameCheck Then
                    GetEntities(oOcc, oSketch)
                End If
            End If
            ' Check to see if this occurrence represents a subassembly
            ' and recursively call this function to traverse through it.
            If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
                TraverseAssembly(oOcc.SubOccurrences, Level + 1, oSketch, InterNameCheck)
            End If
        Next
    End Sub
	
	
	
	  Private Sub GetEntities(Occ As ComponentOccurrence, oSketch As PlanarSketch)
        ' Because we need the sketch line in the context of the assembly
        ' we need to create a proxy for the sketch line. The proxy
        ' represents the sketch line in the context of the assembly.
        Dim oEdge As Edge = Nothing
        Dim oPartCompdef As PartComponentDefinition = Occ.Definition
        Dim oSurfacebody As SurfaceBody = oPartCompdef.SurfaceBodies.Item(1)
        oEdge = oSurfacebody.Edges.Item(1)
        Dim oEdgeproxy As Object
        Occ.CreateGeometryProxy(oEdge, oEdgeproxy)
        oSketch.AddByProjectingEntity(oEdgeproxy)
    End Sub

[Covello_O]

Hi
I tried the code but it throws an error on line 24

oSketch.Name = oNewName

[nstevelmans · Accepted solution]

Hi, try to replace

oSketch.Name = oNewName

With

Try

OSketch.name = oNewName

Catch

End try 

[Covello_O]

.

[Covello_O]

you're the man!