Solved: Create Work Axis for Punch Feature items

checkcheck_master · ‎04-19-2021

Hi there,

To constrain things to a Puch Feature we've add a Work Axis to the punches.

I would like to automate that process.

With:

For Each oSketch In oDoc.ComponentDefinition.Sketches
  Dim oPoint As Inventor.SketchPoint
  For Each oPoint In oSketch.SketchPoints
    oDef.WorkAxes.AddByNormalToSurface(oSketch.PlanarEntity, oPoint)
  Next
Next

For each and every point an Axis is created, fillets etc. which is a little too much.

How can I filter/get only the Points who belong to a Punch Feature?

Greetings!

Ralf_Krieg · ‎04-19-2021

Hello

Try this:

Dim oDoc As PartDocument = ThisDoc.Document
Dim oDef As PartComponentDefinition = oDoc.ComponentDefinition
Dim oSketch As PlanarSketch
Dim oPoint As Inventor.SketchPoint
Dim oPunchToolFeature As PunchToolFeature

For Each oPunchToolFeature In oDoc.ComponentDefinition.Features.PunchToolFeatures
    For Each oPoint In oPunchToolFeature.PunchCenterPoints
        oSketch = oPoint.Parent
        oDef.WorkAxes.AddByNormalToSurface(oSketch.PlanarEntity, oPoint)
    Next
Next

R. Krieg
RKW Solutions
www.rkw-solutions.com

checkcheck_master · ‎04-19-2021

Wonderful Krieg, thanks a lot!
I'm trying to study the API Object Model and searching the API help to get my solutions.
You've got any tips/links/documents learning this?

How to add only Axis that not already exist?
Can I iterate the already existing Axes and check for a reference with a Punch feature?

Greetings!

Ralf_Krieg · ‎04-19-2021

Hello

This can be done by comparing the definition point of the work axis and the sketch point. If the current sketch point is the same as one definition point of an existing work axis, the script would skip creating a new one.

Private Sub Main()
	
	Dim oDoc As PartDocument = ThisDoc.Document
	Dim oDef As PartComponentDefinition = oDoc.ComponentDefinition
	Dim oSketch As PlanarSketch
	Dim oPoint As Inventor.SketchPoint
	Dim oPunchToolFeature As PunchToolFeature

	For Each oPunchToolFeature In oDoc.ComponentDefinition.Features.PunchToolFeatures
	    For Each oPoint In oPunchToolFeature.PunchCenterPoints
			If PointUsed(oDef,oPoint) = False Then
	        	oSketch = oPoint.Parent
	        	oDef.WorkAxes.AddByNormalToSurface(oSketch.PlanarEntity, oPoint)
			End If
	    Next
	Next

End Sub

Private Function PointUsed(ByVal oDef As PartComponentDefinition, ByVal oPoint As Inventor.SketchPoint) As Boolean
	Dim oWorkAxis As Inventor.WorkAxis
	Dim oWorkAxisDef As NormalToSurfaceWorkAxisDef
	For Each oWorkAxis In oDef.WorkAxes
		If oWorkAxis.DefinitionType = WorkAxisDefinitionEnum.kNormalToSurfaceWorkAxis Then
			oWorkAxisDef = oWorkAxis.Definition
			If oWorkAxisDef.Point Is oPoint Then
				Return True
			End If
		End If		
	Next
	Return False
End Function

R. Krieg
RKW Solutions
www.rkw-solutions.com

checkcheck_master · ‎04-19-2021

Thanks again Krieg!

I'm so free to ask you another question about an earlier topic we discussed, the renaming of the sketches.

Basically it works until a sketch number appears that already exist, despite this not apparent from the recursive search of all sketches based on the browser tree. In my head I can reason the solution, but converting it into the correct code is still a thing. I understand that I have to take another variable that has to be incremented every time the renaming was successful and I need a boolean that indicates whether or not the rename was successful. Specific this I struggle with.

Please see the code, 1ste the part I struggle with, starting by 'Rename temp', 2nd some corresponding variables and the cursive function and 3th the complete code.

Thanks in advance.

Greetings!

' Rename Sketches
'----------------------------------------------------------------------------------------------------
' Iterate BrowserNodes and collect all Sketches

	Dim oPane As BrowserPane
    ' Get the BrowserPane that support the search box.
    If oPartDoc.DocumentType = kPartDocumentObject Then
         oPane = oPartDoc.BrowserPanes("PmDefault")
    ElseIf oPartDoc.DocumentType = kAssemblyDocumentObject Then
         oPane = oPartDoc.BrowserPanes("AmBrowserArrangement")
    ElseIf oPartDoc.DocumentType = kDrawingDocumentObject Then
         oPane = oPartDoc.BrowserPanes("DlHierarchy")
    ElseIf oPartDoc.DocumentType = kPresentationDocumentObject Then
         oPane = oPartDoc.BrowserPanes("DxHierarchy")
    End If

    Dim items As String
    items = GetBrowserNodes(oPane.TopNode.BrowserNodes)
	
	' Reset PassedOrigin
	PassedOrigin = False

'	MessageBox.Show(items)
'	oWrite.WriteLine("items as String:")
'	oWrite.WriteLine(items)
'	oWrite.WriteLine("")
	
'For Each element In ListWithSketches
'	oWrite.WriteLine(element)	
'Next
'	oWrite.WriteLine("")
		'ListWithSketches.sort

' Overview
For i = 0 To ListWithSketches.count - 1
	oWrite.WriteLine(i+1 & ": " & ListWithSketches(i) & " (ListWithSketches)")
Next
	oWrite.WriteLine("")
		For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
		    oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
		Next
	oWrite.WriteLine("")
		' Sketch nummer uit ListWithSketches(i) obv inhoud 
		For i = 0 To ListWithSketches.count - 1
		    oWrite.WriteLine(Replace(ListWithSketches(i),"Sketch",""))
		Next
	oWrite.WriteLine("")
		' Rename temp
		oWrite.WriteLine("Rename: ")
		' Doorloop alle gevonden Sketches
		Dim j As Integer
		Dim l As Integer
		
		For i = 0 To ListWithSketches.count - 1
			oWrite.WriteLine("ListWithSketches " & i+1 & ": " & ListWithSketches(i))
			'Zoek de gevonden Sketch in de 'Inventor volgorde lijst' en hernoem deze plaats vzv Temp
			For j = 1 To oPartDoc.ComponentDefinition.Sketches.Count
		    	'oWrite.WriteLine(PartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
				If oPartDoc.ComponentDefinition.Sketches(j).Name = ListWithSketches(i) Then
					'Dim Bool As Boolean
					'If Not oPartDoc.ComponentDefinition.Sketches(j).Name = "Sketch" & i + 1 & " Temp" Then Bool =  False
					'oWrite.WriteLine("Rename Sketch result: " & Bool)
					On Error Resume Next
					If bool(oPartDoc.ComponentDefinition.Sketches(j).Name = "Sketch" & i + 1 & " Temp") Then
						
					End If
				End If	
				'oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
			Next
		Next
		
		' Rename final
		For j = 1 To oPartDoc.ComponentDefinition.Sketches.Count
	    	'oWrite.WriteLine(PartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
			'If oPartDoc.ComponentDefinition.Sketches(j).Name = ListWithSketches(i) Then
				oPartDoc.ComponentDefinition.Sketches(j).Name = Replace(oPartDoc.ComponentDefinition.Sketches(j).Name," Temp","")
			'End If	
			'oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
		Next

' List to collect all Sketches from BrowserNodes
Public ListWithSketches As New List(Of String)
'Public ListWithSketches As New SortedList(Of String, Integer)
'Public C As Integer = 1

' Om de Sketches 'zuiver' te krijgen gaan we ze pas verzamelen nadat we de 'Origin' zijn gepasseerd
' Anders krijgen we ook de Sketches onder 'Solid' waarbij de volgorde niet overeen komt wanneer er oa Shared Sketches voorkomen
Public PassedOrigin As Boolean

Function GetBrowserNodes(nodes As BrowserNodesEnumerator) As String
    	
	Dim node As BrowserNode
    For Each node In nodes
        If node.BrowserNodeDefinition.Label.ToString Like "*Origin*" Then PassedOrigin = True
		If node.BrowserNodeDefinition.Label.ToString Like "*Sketch*" And PassedOrigin = True Then
		'If IsNumeric(Right(node.BrowserNodeDefinition.Label.ToString,1)) Then
		'If node.Selected Then
            If ListWithSketches.Contains(node.BrowserNodeDefinition.Label.ToString) = False Then
			'If ListWithSketches.Containsvalue(node.BrowserNodeDefinition.Label.ToString) = False Then
				ListWithSketches.Add(node.BrowserNodeDefinition.Label.ToString)
				'ListWithSketches.Add(C, node.BrowserNodeDefinition.Label.ToString)
				'C= C + 1
			End If
			
		'End If
		'End If
		End If
		
		' For Debugging, check items as String in Sub Main
		GetBrowserNodes = GetBrowserNodes + vbCrLf + node.BrowserNodeDefinition.Label.ToString
        GetBrowserNodes = GetBrowserNodes + GetBrowserNodes(node.BrowserNodes)
    Next
		
	Return ListWithSketches.ToString 

End Function

Sub Main()

'----------------------------------------------------------------------------------------------------
' Write to textfile
Dim strDateAndTime As String
strDateAndTime = DateTime.Now.ToString(("yyyy-MM-dd HHmmss"))
Dim LogFileName As String
LogFileName = "C:\temp\iLogic_Log_" & strDateAndTime & ".txt"
oWrite = System.IO.File.CreateText(LogFileName)
'oWrite = System.IO.File.CreateText(ThisDoc.PathAndFileName(False) & ".txt")
'----------------------------------------------------------------------------------------------------
' Calculate elapsed time
Dim oWatch As New Stopwatch
oWatch.Start
'----------------------------------------------------------------------------------------------------
' Features 
Dim iAliasFreeform As Integer
Dim iBend As Integer
Dim iBoss As Integer
Dim iBoundaryPatch As Integer
Dim iChamfer As Integer
Dim iCircularpattern As Integer
Dim iClient As Integer
Dim iCoil As Integer
Dim iCombine As Integer
Dim iCoreCavity As Integer

Dim iCornerChamferFeatureObject As Integer

Dim iCornerRoundFeatureObject As Integer

Dim iContourFlangeFeatureObject As Integer

Dim iCutFeatureObject As Integer

Dim iDecal As Integer
Dim iDeleteFace As Integer
Dim iDirectEdit As Integer
Dim iEmboss As Integer
Dim iExtend As Integer
Dim iExtrude As Integer
Dim iFaceDraft As Integer

Dim iFace As Integer

Dim iFaceOffset As Integer
Dim iFillet As Integer

Dim iFlangeFeatureObject As Integer

Dim iFreeform As Integer
Dim iGrill As Integer
Dim iHole As Integer
Dim iKnit As Integer
Dim iLip As Integer
Dim iLoft As Integer
Dim iMidsurface As Integer
Dim iMirror As Integer
Dim iMoveFace As Integer
Dim iMove As Integer

Dim iNonParametricBaseFeatureObject As Integer

'NonParametricBaseFeature
'NonParametricBaseFeatures

Dim kPunchToolFeatureObject As Integer

Dim iRectangularPattern As Integer
'Reference
Dim iReplaceFace As Integer
Dim iRest As Integer
Dim iRevolve As Integer

Dim iReferenceFeatureObject As Integer

Dim iRib As Integer
Dim iRuledSurface As Integer
Dim iRuleFillet As Integer
Dim iSculpt As Integer
Dim iShell As Integer
Dim iSketchDrivenPattern As Integer
Dim iSnapFit As Integer
Dim iSplit As Integer

Dim kSurfaceBodyObject As Integer

Dim iSweep As Integer
Dim iThicken As Integer
Dim iThread As Integer
Dim iTrim As Integer
Dim iUnwrap As Integer
'----------------------------------------------------------------------------------------------------
Dim i As Integer
'----------------------------------------------------------------------------------------------------
Dim oPartDoc As PartDocument = ThisDoc.Document
Dim oFeatures As PartFeatures = oPartDoc.ComponentDefinition.Features
Dim oDef As PartComponentDefinition = oPartDoc.ComponentDefinition
'----------------------------------------------------------------------------------------------------
' Rebuild All
ThisDoc.Document.Rebuild()
'----------------------------------------------------------------------------------------------------
'' For Debugging
'oWrite.WriteLine("")
'For Each oFeature In oFeatures
' 	oWrite.WriteLine("Before actions: " & oFeature.name)
'Next
'oWrite.WriteLine("")
'----------------------------------------------------------------------------------------------------
' Undo Wrapper
Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(oPartDoc, "Do your thing...")
'----------------------------------------------------------------------------------------------------
' Rename Solid Bodies
Dim iSolidCount As Integer
Dim oSolid As SurfaceBody
'----------------------------------------------------------------------------------------------------

For Each oSolid In oDef.SurfaceBodies
	iSolidCount = iSolidCount + 1
	oSolid.Name = "Solid" & iSolidCount.ToString & " " & strDateAndTime
Next

	iSolidsCount = 0
	For Each oSolid In oDef.SurfaceBodies
		iSolidsCount = iSolidCount + 1
		oSolid.Name = "Solid" & iSolidCount.ToString
	Next
	
'----------------------------------------------------------------------------------------------------
' Work Features
Dim iWorkPlane As Integer
Dim iWorkPoint As Integer
Dim iWorkAxis As Integer
Dim iWorkSurface As Integer
'----------------------------------------------------------------------------------------------------
' Rename Work Features:
'----------------------------------------------------------------------------------------------------
' Rename Work Planes
For Each oWorkPlane In oDef.WorkPlanes
	If 	oWorkPlane.Name <> "Start plane" And oWorkPlane.Name <> "End plane" Then
		If oWorkPlane.IsCoordinateSystemElement = False  Then
			iWorkPlane = iWorkPlane + 1
			oWorkPlane.Name = "Work Plane" & iWorkPlane.ToString & " " & strDateAndTime
		End If
	End If
Next

		iWorkPlane = 0
		For Each oWorkPlane In oDef.WorkPlanes
			If 	oWorkPlane.Name <> "Start plane" And oWorkPlane.Name <> "End plane" Then
				If oWorkPlane.IsCoordinateSystemElement = False  Then
					iWorkPlane = iWorkPlane + 1
					oWorkPlane.Name = "Work Plane" & iWorkPlane.ToString
				End If
			End If
		Next
'----------------------------------------------------------------------------------------------------
' Rename Work Points
For Each oWorkPoint In oDef.WorkPoints
	If oWorkPoint.IsCoordinateSystemElement = False  Then
		iWorkPoint = iWorkPoint + 1
		oWorkPoint.Name = "Work Point" & iWorkPoint.ToString & " " & strDateAndTime
	End If
Next

	iWorkPoint = 0
	For Each oWorkPoint In oDef.WorkPoints
		If oWorkPoint.IsCoordinateSystemElement = False  Then
			iWorkPoint = iWorkPoint + 1
			oWorkPoint.Name = "Work Point" & iWorkPoint.ToString
		End If
	Next
'----------------------------------------------------------------------------------------------------
' Rename Work Axis
For Each oWorkAxis In oDef.WorkAxes
	If oWorkAxis.IsCoordinateSystemElement = False  Then
		iWorkAxis = iWorkAxis + 1
		oWorkAxis.Name = "Work Axis" & iWorkAxis.ToString & " " & strDateAndTime
	End If
Next
	
	iWorkAxis = 0
	For Each oWorkAxis In oDef.WorkAxes
		If oWorkAxis.IsCoordinateSystemElement = False  Then
			iWorkAxis = iWorkAxis + 1
			oWorkAxis.Name = "Work Axis" & iWorkAxis.ToString
		End If
	Next
'----------------------------------------------------------------------------------------------------
' Rename Work Surface
For Each oWorkSurface In oDef.WorkSurfaces
	iWorkSurface = iWorkSurface + 1
	oWorkSurface.Name = "Work Surface" & iWorkSurface.ToString & " " & strDateAndTime
Next
	
	iWorkSurface = 0
	For Each oWorkSurface In oDef.WorkSurfaces
		iWorkSurface = iWorkSurface + 1
		oWorkSurface.Name = "Work Surface" & iWorkSurface.ToString
	Next
'----------------------------------------------------------------------------------------------------
'Rename Features
For i = 1 To oFeatures.Count
	If oFeatures(i).Name <> "Body" And _
	   oFeatures(i).Name <> "Driven Length" And _
	   oFeatures(i).Type <> ObjectTypeEnum.kReferenceFeatureObject Then
    		oFeatures(i).Name = i & " " & strDateAndTime
	end if
Next

'MessageBox.Show("Wait...")

For i = 1 To oFeatures.Count
    Select Case oFeatures(i).Type
        Case ObjectTypeEnum.kAliasFreeformFeatureObject:
            iAliasFreeform = iAliasFreeform + 1
            oFeatures(i).Name = "Alias Freeform" & CStr(iAliasFreeform)
        Case ObjectTypeEnum.kBendFeatureObject:
            iBend = iBend + 1
            oFeatures(i).Name = "Bend" & CStr(iBend)
        Case ObjectTypeEnum.kBossFeatureObject:
            iBoss = iBoss + 1
            oFeatures(i).Name = "Boss" & CStr(iBoss)
        Case ObjectTypeEnum.kBoundaryPatchFeatureObject:
            iBoundaryPatch = iBoundaryPatch + 1
            oFeatures(i).Name = "Boundary Patch" & CStr(iBoundaryPatch)
        Case ObjectTypeEnum.kChamferFeatureObject:
            iChamfer = iChamfer + 1
            oFeatures(i).Name = "Chamfer" & CStr(iChamfer)
        Case ObjectTypeEnum.kCircularPatternFeatureObject:
            iCircularpattern = iCircularpattern + 1
            oFeatures(i).Name = "Circular Pattern" & CStr(iCircularpattern)
        Case ObjectTypeEnum.kClientFeatureObject:
            If oFeatures(i).Name <> "Driven Length"
				iClient = iClient + 1
            	oFeatures(i).Name = "Client" & CStr(iClient)
        	End If
		Case ObjectTypeEnum.kCoilFeatureObject :
            iCoil = iCoil + 1
            oFeatures(i).Name = "Coil" & CStr(iCoil)
        Case ObjectTypeEnum.kCombineFeatureObject:
            iCombine = iCombine + 1
            oFeatures(i).Name = "Combine" & CStr(iCombine)
        Case ObjectTypeEnum.kCoreCavityFeatureObject:
            iCoreCavity = iCoreCavity + 1
            oFeatures(i).Name = "Core Cavity" & CStr(iCoreCavity)
			
		Case ObjectTypeEnum.kCornerChamferFeatureObject:
            iCornerChamferFeatureObject = iCornerChamferFeatureObject + 1
            oFeatures(i).Name = "Corner Chamfer" & CStr(iCornerChamferFeatureObject)	
        
		Case ObjectTypeEnum.kCornerRoundFeatureObject:
            iCornerRound = iCornerRound + 1
            oFeatures(i).Name = "Corner Round" & CStr(iCornerRound)
			
		Case ObjectTypeEnum.kContourFlangeFeatureObject:
            iContourFlangeFeatureObject = iContourFlangeFeatureObject + 1
            oFeatures(i).Name = "Contour Flange" & CStr(iContourFlangeFeatureObject)	
				
		Case ObjectTypeEnum.kCutFeatureObject:
            iCut = iCut + 1
            oFeatures(i).Name = "Cut" & CStr(iCut)
					
		Case ObjectTypeEnum.kDecalFeatureObject :
            iDecal = iDecal + 1
            oFeatures(i).Name = "Decal" & CStr(iDecal)
        Case ObjectTypeEnum.kDeleteFaceFeatureObject:
            iDeleteFace = iDeleteFace + 1
            oFeatures(i).Name = "Delete Face" & CStr(iDeleteFace)
        Case ObjectTypeEnum.kDirectEditFeatureObject:
            iDirectEdit = iDirectEdit + 1
            oFeatures(i).Name = "Direct Edit" & CStr(iDirectEdit)
        Case ObjectTypeEnum.kEmbossFeatureObject:
            iEmboss = iEmboss + 1
            oFeatures(i).Name = "Emboss" & CStr(iEmboss)
        Case ObjectTypeEnum.kExtendFeatureObject:
            iExtend = iExtend + 1
            oFeatures(i).Name = "Extend" & CStr(iExtend)
        
		Case ObjectTypeEnum.kExtrudeFeatureObject :
			'messagebox.Show(oFeatures(i).Name)
            If oFeatures(i).Name <> "Body" Then
				iExtrude = iExtrude + 1           
				''MessageBox.Show(iExtrude & " - i =" & i & " - CStr: " & CStr(iExtrude))
				oFeatures(i).Name = "Extrusion" & CStr(iExtrude)
			End If
		
		Case ObjectTypeEnum.kFaceDraftFeatureObject :
            iFaceDraft = iFaceDraft + 1
            oFeatures(i).Name = "Face Draft" & CStr(iFaceDraft)		
        
		Case ObjectTypeEnum.kFaceFeatureObject:
            iFace = iFace + 1
            oFeatures(i).Name = "Face" & CStr(iFace)
		
		Case ObjectTypeEnum.kFaceOffsetFeatureObject :
            iFaceOffset = iFaceOffset + 1
            oFeatures(i).Name = "Face Offset" & CStr(iFaceOffset)
        Case ObjectTypeEnum.kFilletFeatureObject:
            iFillet = iFillet + 1
            oFeatures(i).Name = "Fillet" & CStr(iFillet)
			
		Case ObjectTypeEnum.kFlangeFeatureObject:
            iFlangeFeatureObject = iFlangeFeatureObject + 1
            oFeatures(i).Name = "Flange" & CStr(iFlangeFeatureObject)	
        		
		Case ObjectTypeEnum.kFreeformFeatureObject :
            iFreeform = iFreeform + 1
            oFeatures(i).Name = "Freeform" & CStr(iFreeform)
        Case ObjectTypeEnum.kGrillFeatureObject:
            iGrill = iGrill + 1
            oFeatures(i).Name = "Grill" & CStr(iGrill)
        Case ObjectTypeEnum.kHoleFeatureObject:
            iHole = iHole + 1
            oFeatures(i).Name = "Hole" & CStr(iHole)
        Case ObjectTypeEnum.kKnitFeatureObject:
            iKnit = iKnit + 1
            oFeatures(i).Name = "Knit" & CStr(iKnit)
        Case ObjectTypeEnum.kLipFeatureObject:
            iLip = iLip + 1
            oFeatures(i).Name = "Lip" & CStr(iLip)
        Case ObjectTypeEnum.kLoftFeatureObject:
            iLoft = iLoft + 1
            oFeatures(i).Name = "Loft" & CStr(iLoft)
        Case ObjectTypeEnum.kMidSurfaceFeatureObject:
            iMidsurface = iMidsurface + 1
            oFeatures(i).Name = "Midsurface" & CStr(iMidsurface)
        Case ObjectTypeEnum.kMirrorFeatureObject:
            iMirror = iMirror + 1
            oFeatures(i).Name = "Mirror" & CStr(iMirror)
        Case ObjectTypeEnum.kMoveFaceFeatureObject:
            iMoveFace = iMoveFace + 1
            oFeatures(i).Name = "MoveFace" & CStr(iMoveFace)
			
		Case ObjectTypeEnum.kNonParametricBaseFeatureObject:
            iNonParametricBaseFeatureObject = iNonParametricBaseFeatureObject + 1
            oFeatures(i).Name = "Solid Body" & CStr(iNonParametricBaseFeatureObject)	
        
		Case ObjectTypeEnum.kMoveFeatureObject :
            iMove = iMove + 1
            oFeatures(i).Name = "Move" & CStr(iMove)
			
		Case ObjectTypeEnum.kPunchToolFeatureObject:
            iPunchToolFeature = iPunchToolFeature + 1
            oFeatures(i).Name = "Punch Tool Feature" & CStr(iPunchToolFeature)
				
        Case ObjectTypeEnum.kRectangularPatternFeatureObject:
            iRectangularPattern = iRectangularPattern + 1
            oFeatures(i).Name = "Rectangular Pattern" & CStr(iRectangularPattern)
			
		Case ObjectTypeEnum.kReferenceFeatureObject:
            ' Do nothing waarschijnlijk een mirrorpart
		
			'iReferenceFeatureObject = iReferenceFeatureObject + 1
            'oFeatures(i).Name = "Rectangular Pattern" & CStr(iReferenceFeatureObject)	
			
        Case ObjectTypeEnum.kReplaceFaceFeatureObject:
            iReplaceFace = iReplaceFace + 1
            oFeatures(i).Name = "ReplaceFace" & CStr(iReplaceFace)
        Case ObjectTypeEnum.kRestFeatureObject:
            iRest = iRest + 1
            oFeatures(i).Name = "Rest" & CStr(iRest)
        Case ObjectTypeEnum.kRevolveFeatureObject:
            iRevolve = iRevolve + 1
            oFeatures(i).Name = "Revolve" & CStr(iRevolve)
        Case ObjectTypeEnum.kRibFeatureObject:
            iRib = iRib + 1
            oFeatures(i).Name = "Rib" & CStr(iRib)
        Case ObjectTypeEnum.kRuledSurfaceFeatureObject:
            iRuledSurface = iRuledSurface + 1
            oFeatures(i).Name = "Ruled Surface" & CStr(iRuledSurface)
        Case ObjectTypeEnum.kRuleFilletFeatureObject:
            iRuleFillet = iRuleFillet + 1
            oFeatures(i).Name = "Rule Fillet" & CStr(iRuleFillet)
        Case ObjectTypeEnum.kSculptFeatureObject:
            iSculpt = iSculpt + 1
            oFeatures(i).Name = "Sculpt" & CStr(iSculpt)
        Case ObjectTypeEnum.kShellFeatureObject:
            iShell = iShell + 1
            oFeatures(i).Name = "Shell" & CStr(iShell)
        Case ObjectTypeEnum.kSketchDrivenPatternFeatureObject:
            iSketchDrivenPattern = iSketchDrivenPattern + 1
            oFeatures(i).Name = "Sketch Driven Pattern" & CStr(iSketchDrivenPattern)
        Case ObjectTypeEnum.kSnapFitFeatureObject:
            iSnapFit = iSnapFit + 1
            oFeatures(i).Name = "SnapFit" & CStr(iSnapFit)
        Case ObjectTypeEnum.kSplitFeatureObject:
            iSplit = iSplit + 1
            oFeatures(i).Name = "Split" & CStr(iSplit)
			
		Case ObjectTypeEnum.kSurfaceBodyObject:
            ikSurfaceBodyObject = ikSurfaceBodyObject + 1
            oFeatures(i).Name = "Solid" & CStr(ikSurfaceBodyObject)					
			
        Case ObjectTypeEnum.kSweepFeatureObject:
            iSweep = iSweep + 1
            oFeatures(i).Name = "Sweep" & CStr(iSweep)
        Case ObjectTypeEnum.kThickenFeatureObject:
            iThicken = iThicken + 1
            oFeatures(i).Name = "Thicken" & CStr(iThicken)
        Case ObjectTypeEnum.kThreadFeatureObject:
            iThread = iThread + 1
            oFeatures(i).Name = "Thread" & CStr(iThread)
        Case ObjectTypeEnum.kTrimFeatureObject:
            iTrim = iTrim + 1
            oFeatures(i).Name = "Trim" & CStr(iTrim)
' Not for IV2019			
'        Case ObjectTypeEnum.kUnwrapFeatureObject:
'            iUnwrap = iUnwrap + 1
'            oFeatures(i).Name = "Unwrap" & CStr(iUnwrap)
        Case Else:
            MsgBox ("Unknown feature detected: " & CStr(oFeatures(i).Type))
    End Select
Next

'----------------------------------------------------------------------------------------------------
' Rename Sketches
'----------------------------------------------------------------------------------------------------
' Iterate BrowserNodes and collect all Sketches

	Dim oPane As BrowserPane
    ' Get the BrowserPane that support the search box.
    If oPartDoc.DocumentType = kPartDocumentObject Then
         oPane = oPartDoc.BrowserPanes("PmDefault")
    ElseIf oPartDoc.DocumentType = kAssemblyDocumentObject Then
         oPane = oPartDoc.BrowserPanes("AmBrowserArrangement")
    ElseIf oPartDoc.DocumentType = kDrawingDocumentObject Then
         oPane = oPartDoc.BrowserPanes("DlHierarchy")
    ElseIf oPartDoc.DocumentType = kPresentationDocumentObject Then
         oPane = oPartDoc.BrowserPanes("DxHierarchy")
    End If

    Dim items As String
    items = GetBrowserNodes(oPane.TopNode.BrowserNodes)
	
	' Reset PassedOrigin
	PassedOrigin = False

'	MessageBox.Show(items)
'	oWrite.WriteLine("items as String:")
'	oWrite.WriteLine(items)
'	oWrite.WriteLine("")
	
'For Each element In ListWithSketches
'	oWrite.WriteLine(element)	
'Next
'	oWrite.WriteLine("")
		'ListWithSketches.sort

' Overview
For i = 0 To ListWithSketches.count - 1
	oWrite.WriteLine(i+1 & ": " & ListWithSketches(i) & " (ListWithSketches)")
Next
	oWrite.WriteLine("")
		For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
		    oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
		Next
	oWrite.WriteLine("")
		' Sketch nummer uit ListWithSketches(i) obv inhoud 
		For i = 0 To ListWithSketches.count - 1
		    oWrite.WriteLine(Replace(ListWithSketches(i),"Sketch",""))
		Next
	oWrite.WriteLine("")
		' Rename temp
		oWrite.WriteLine("Rename: ")
		' Doorloop alle gevonden Sketches
		Dim j As Integer
		Dim l As Integer
		
		For i = 0 To ListWithSketches.count - 1
			oWrite.WriteLine("ListWithSketches " & i+1 & ": " & ListWithSketches(i))
			'Zoek de gevonden Sketch in de 'Inventor volgorde lijst' en hernoem deze plaats vzv Temp
			For j = 1 To oPartDoc.ComponentDefinition.Sketches.Count
		    	'oWrite.WriteLine(PartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
				If oPartDoc.ComponentDefinition.Sketches(j).Name = ListWithSketches(i) Then
					'Dim Bool As Boolean
					'If Not oPartDoc.ComponentDefinition.Sketches(j).Name = "Sketch" & i + 1 & " Temp" Then Bool =  False
					'oWrite.WriteLine("Rename Sketch result: " & Bool)
					On Error Resume Next
					If bool(oPartDoc.ComponentDefinition.Sketches(j).Name = "Sketch" & i + 1 & " Temp") Then
						
					End If
				End If	
				'oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
			Next
		Next
		
		' Rename final
		For j = 1 To oPartDoc.ComponentDefinition.Sketches.Count
	    	'oWrite.WriteLine(PartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
			'If oPartDoc.ComponentDefinition.Sketches(j).Name = ListWithSketches(i) Then
				oPartDoc.ComponentDefinition.Sketches(j).Name = Replace(oPartDoc.ComponentDefinition.Sketches(j).Name," Temp","")
			'End If	
			'oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
		Next


'		For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'		    oPartDoc.ComponentDefinition.Sketches(i).Name = "Sketch" & Replace(ListWithSketches(i-1),"Sketch","") & " Temp"
'		Next
'	oWrite.WriteLine("")
'		' Rename 
'		For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'		    oPartDoc.ComponentDefinition.Sketches(i).Name = Replace(oPartDoc.ComponentDefinition.Sketches(i).Name, "Temp", "")
'			oPartDoc.ComponentDefinition.Sketches(i).Name = Replace(oPartDoc.ComponentDefinition.Sketches(i).Name," ","")
'		Next	
	oWrite.WriteLine("")
		' Result
		For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
		    oWrite.WriteLine(i & ": " & oPartDoc.ComponentDefinition.Sketches(i).Name & " (oPartDoc.ComponentDefinition.Sketches)")
		Next
	oWrite.WriteLine("")	
		' Refill List
		ListWithSketches.clear
		Dim items2 As String
		items2 = GetBrowserNodes(oPane.TopNode.BrowserNodes)
		' Overview
		For i = 0 To ListWithSketches.count - 1
			oWrite.WriteLine(i+1 & ": " & ListWithSketches(i) & " (ListWithSketches)")
		Next	
'		MessageBox.Show(items2)

'Dim oSketch As Sketch
'For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'    oWrite.WriteLine(oPartDoc.ComponentDefinition.Sketches(i).Name & " - " & ListWithSketches(i-1))
'Next

'For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'    oPartDoc.ComponentDefinition.Sketches(i).Name = ListWithSketches(i-1) & strDateAndTime
'Next

'For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'    oPartDoc.ComponentDefinition.Sketches(i).Name = ListWithSketches(i-1)
'Next

'oWrite.WriteLine("----------------------------------------------------------------------------------------------------")

'For i = 1 To oPartDoc.ComponentDefinition.Sketches.Count
'    oWrite.WriteLine(oPartDoc.ComponentDefinition.Sketches(i).Name & " - " & ListWithSketches(i-1))
'Next

'----------------------------------------------------------------------------------------------------
' Undo Wrapper
trans.End()

'	oWrite.WriteLine("")
'		' Test 
'		For i = 1 To oPartDoc.ComponentDefinition.Features.ReferenceFeatures.Count
'		    oWrite.WriteLine(oPartDoc.ComponentDefinition.Features.ReferenceFeatures(i).Name)
			
'		Next
		
'		For Each oSolid In oDef.SurfaceBodies
'			For Each oSolid1 In oSolid.Faces
'				For Each osolid3 In oSolid1.ed..iSolidCount = iSolidCount + 1
				
'				Next
'			Next
'		Next

'----------------------------------------------------------------------------------------------------
'MsgBox("Done",,"iLogic")
'----------------------------------------------------------------------------------------------------
' Rebuild All
ThisDoc.Document.Rebuild()
'----------------------------------------------------------------------------------------------------
'' For Debugging
'oWrite.WriteLine("")
'For Each oFeature In oFeatures
' 	oWrite.WriteLine("After actions: " & oFeature.name)
'Next
'----------------------------------------------------------------------------------------------------
'Calculate elapsed time.
oWatch.Stop()
oWrite.WriteLine(vbNewLine & "Done!" & vbNewLine & ("Elapsed Time: " & oWatch.ElapsedMilliseconds.ToString & " Milliseconds"))
'MsgBox         (vbNewLine & "Done!" & vbNewLine & ("Elapsed Time: " & oWatch.ElapsedMilliseconds.ToString & " Milliseconds"))
'----------------------------------------------------------------------------------------------------
oWrite.Close()
'Dim p As System.Diagnostics.Process = Process.Start(LogFileName)
ThisDoc.Launch(LogFileName)
'ThisDoc.Launch(ThisDoc.PathAndFileName(False) & ".txt")
'----------------------------------------------------------------------------------------------------
'Set focus back the Inventor application
On Error Resume Next
Dim App As Process() = Process.GetProcessesByName("Inventor")
If App.Length > 0 Then
	AppActivate(App(0).Id)
End If
'----------------------------------------------------------------------------------------------------
End Sub

' List to collect all Sketches from BrowserNodes
Public ListWithSketches As New List(Of String)
'Public ListWithSketches As New SortedList(Of String, Integer)
'Public C As Integer = 1

' Om de Sketches 'zuiver' te krijgen gaan we ze pas verzamelen nadat we de 'Origin' zijn gepasseerd
' Anders krijgen we ook de Sketches onder 'Solid' waarbij de volgorde niet overeen komt wanneer er oa Shared Sketches voorkomen
Public PassedOrigin As Boolean

Function GetBrowserNodes(nodes As BrowserNodesEnumerator) As String
    	
	Dim node As BrowserNode
    For Each node In nodes
        If node.BrowserNodeDefinition.Label.ToString Like "*Origin*" Then PassedOrigin = True
		If node.BrowserNodeDefinition.Label.ToString Like "*Sketch*" And PassedOrigin = True Then
		'If IsNumeric(Right(node.BrowserNodeDefinition.Label.ToString,1)) Then
		'If node.Selected Then
            If ListWithSketches.Contains(node.BrowserNodeDefinition.Label.ToString) = False Then
			'If ListWithSketches.Containsvalue(node.BrowserNodeDefinition.Label.ToString) = False Then
				ListWithSketches.Add(node.BrowserNodeDefinition.Label.ToString)
				'ListWithSketches.Add(C, node.BrowserNodeDefinition.Label.ToString)
				'C= C + 1
			End If
			
		'End If
		'End If
		End If
		
		' For Debugging, check items as String in Sub Main
		GetBrowserNodes = GetBrowserNodes + vbCrLf + node.BrowserNodeDefinition.Label.ToString
        GetBrowserNodes = GetBrowserNodes + GetBrowserNodes(node.BrowserNodes)
    Next
		
	Return ListWithSketches.ToString 

End Function

Ralf_Krieg · ‎04-22-2021

Hello

Take a look at my new idea in this thread . Maybe this is a solution even for this problem.

R. Krieg
RKW Solutions
www.rkw-solutions.com

checkcheck_master · ‎05-10-2021

Hello Krieg,

I posted a message with a question in https://forums.autodesk.com/t5/inventor-customization/ilogic-get-all-underlying-feature-items/td-p/1....

If you have the opportunity to answer, please.