Community
Inventor Programming - iLogic, Macros, AddIns & Apprentice
Inventor iLogic, Macros, AddIns & Apprentice Forum. Share your knowledge, ask questions, and explore popular Inventor topics related to programming, creating add-ins, macros, working with the API or creating iLogic tools.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

How to split/trim 2D curved sketch geometry to intersection

0 REPLIES 0
Reply
Message 1 of 1
chewy_robot
235 Views, 0 Replies

How to split/trim 2D curved sketch geometry to intersection

 

 I currently have a rule that runs in an assembly edit environment on a part. Once you are editing a part in an assembly, you can run this rule and it allows you to select a face on the part and it projects all cut edges to the part face as well as projecting the border of the part face. Then, it removes all geometry found outside of the face border and splits/trims lines found outside the face border by finding their intersection, deleting the lines then redrawing them. This works perfectly, except it does not work for curved entities like arcs, circles, splines etc. It does detect that part of the curved geometry intersects with the face border, but instead of trimming to that intersection it just deletes the curved geometry entirely. How do I alter my code so that it "trims" these curved entities to the face border line instead of deleting it entirely? The attached photos are a simplified version of what I'm looking to do with iLogic. I have also attached my current code below (it runs on a part being edited in an assembly):

Public Sub Main()
	' Declare the application object and get the current application
	Dim oApp As Inventor.Application = ThisApplication
	Dim oDoc As Inventor.Document = oApp.ActiveDocument
	Dim oAssDoc As Inventor.AssemblyDocument = oApp.ActiveDocument
	Dim oAssDocDef As Inventor.AssemblyComponentDefinition = oAssDoc.ComponentDefinition
	Dim oFaceProxy As FaceProxy = Nothing
	Dim oSketch As PlanarSketch = Nothing
	Try
		' Prompt user to select a face
		oFaceProxy = oApp.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Pick a face")
		If oFaceProxy Is Nothing Then
			MessageBox.Show("No face was selected.")
			Return
		End If
	Catch ex As Exception
		MessageBox.Show("Error in selecting face: " & ex.Message)
		Return
	End Try
	' Define an empty list to hold occurrences touching the selected face
	Dim oOccurrenceListA As New List(Of ComponentOccurrence)
	Try
		' Iterate through the occurrences in the assembly to find parts touching the selected face
		For Each oOccurrence As ComponentOccurrence In oAssDocDef.Occurrences
			' Check each occurrence against the selected face to find touching parts
			If oApp.MeasureTools.GetMinimumDistance(oOccurrence, oFaceProxy) < 0.01 AndAlso Not oOccurrence Is oFaceProxy.ContainingOccurrence Then
				oOccurrenceListA.Add(oOccurrence)
			End If
		Next
	Catch ex As Exception
		MessageBox.Show("Error finding touching parts: " & ex.Message)
		Return
	End Try
	' Check if any parts are touching the selected face
	If oOccurrenceListA.Count = 0 Then
		' If no parts are touching, notify the user and exit the sub
		MessageBox.Show("No parts touching the selected face. No scribe lines will be created.", "No Parts Touching")
		Return
	End If
	Try
		' Set the default sketch name
		Dim defaultSketchName As String = "SCRIBE LINES"
		' Prompt the user to name the sketch
		Dim userInputName As String = InputBox("Please enter a name for the new sketch:", "Name Sketch", defaultSketchName)
		' Access the occurrence containing the face
		Dim oOcc As ComponentOccurrence = oFaceProxy.ContainingOccurrence
		' Access the part document's component definition
		Dim oMainPartDef As PartComponentDefinition = oOcc.Definition
		' Check if the user input is empty, set it to the default name
		Dim sketchName As String = If (String.IsNullOrWhiteSpace(userInputName), defaultSketchName, userInputName)
		Dim sketchNumber As Integer = 1
		' Check if the sketch name already exists and create a unique name if necessary
		While oMainPartDef.Sketches.OfType(Of PlanarSketch).Any(Function(s) s.Name.Equals(sketchName, StringComparison.OrdinalIgnoreCase))
			' If the user did not provide a unique name, append a number to make it unique
			If sketchName = defaultSketchName OrElse sketchName.StartsWith(defaultSketchName & " ") Then
				sketchName = defaultSketchName & " " & sketchNumber
				sketchNumber += 1
			Else
				' If the user provided a unique name but it's not unique, prompt again
				sketchName = InputBox("The sketch name is already in use. Please enter a unique name for the new sketch:", "Name Sketch", userInputName)
				' Reset the counter if the user is providing names manually
				sketchNumber = 1
				' If the user cancels the prompt, exit the sub
				If sketchName = "" Then Return
			End If
		End While
		' Initialize the sketch variable with the unique name
		oSketch = oMainPartDef.Sketches.Add(oFaceProxy.NativeObject)
		oSketch.Name = sketchName
		oSketch.Edit()  ' Start the sketch editing mode
	Catch ex As Exception
		MessageBox.Show("Error initializing sketch: " & ex.Message)
		Return
	End Try
	' Check if the sketch was created successfully
	If oSketch Is Nothing Then
		MessageBox.Show("Failed to create sketch.")
		Return
	End If
	Dim oOccurrenceList As New List(Of ComponentOccurrence)
	Try
		' Iterate through the occurrences in the assembly to find parts touching the selected face
		For Each oOccurrence As ComponentOccurrence In oAssDocDef.Occurrences
			' Check each occurrence against the selected face to find touching parts
			If oApp.MeasureTools.GetMinimumDistance(oOccurrence, oFaceProxy) < 0.01 AndAlso Not oOccurrence Is oFaceProxy.ContainingOccurrence Then
				oOccurrenceList.Add(oOccurrence)
			End If
		Next
	Catch ex As Exception
		MessageBox.Show("Error finding touching parts: " & ex.Message)
	End Try

	'Begin projecting cut edges on sketch
	Try
		' Start a transaction to project cut edges
		Dim oTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Project Cut Edges")
		Dim oControlDef As ControlDefinition = oApp.CommandManager.ControlDefinitions.Item("SketchProjectCutEdgesCmd")
		oApp.ActiveDocument.SelectSet.Clear() ' Clear current selection
		For Each oOcc In oOccurrenceList
			oApp.ActiveDocument.SelectSet.Select(oOcc)
		Next
		oControlDef.Execute() ' Execute the command
		oTrans.End() ' Commit the transaction
	Catch ex As Exception
		MessageBox.Show("Error projecting cut edges: " & ex.Message)
	Finally
		oApp.CommandManager.StopActiveCommand() ' Ensure no command is left active
	End Try

	' After projecting the edges, create intersection data and new lines
	Dim faceSelected As Face = oFaceProxy.NativeObject
	Dim intersectionData As Dictionary(Of SketchLine, List(Of Point2d)) = CreateIntersectPoints(oSketch, faceSelected)
	' Begin a new transaction to check for entities on the boundary and delete them
	Dim boundaryCheckTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Check Boundary Entities")
	Try
		Dim entitiesOnBoundary As New List(Of SketchEntity)
		Dim entitiesOutsideBoundary As New List(Of SketchEntity)
		' Check each entity in the sketch
		For Each skEntity As SketchEntity In oSketch.SketchEntities
			Dim startPt As Point = Nothing
			Dim endPt As Point = Nothing
			' Get the start and end points for SketchLine entities
			If TypeOf skEntity Is SketchLine Then
				Dim skLine As SketchLine = CType(skEntity, SketchLine)
				startPt = oApp.TransientGeometry.CreatePoint(skLine.StartSketchPoint.Geometry.X, skLine.StartSketchPoint.Geometry.Y, 0)
				endPt = oApp.TransientGeometry.CreatePoint(skLine.EndSketchPoint.Geometry.X, skLine.EndSketchPoint.Geometry.Y, 0)
			ElseIf TypeOf skEntity Is SketchArc Then
				Dim skArc As SketchArc = CType(skEntity, SketchArc)
				startPt = oApp.TransientGeometry.CreatePoint(skArc.StartSketchPoint.Geometry.X, skArc.StartSketchPoint.Geometry.Y, 0)
				endPt = oApp.TransientGeometry.CreatePoint(skArc.EndSketchPoint.Geometry.X, skArc.EndSketchPoint.Geometry.Y, 0)
			ElseIf TypeOf skEntity Is SketchCircle Then
				' For a circle, both points can be the center as we only check if it's inside the boundary
				Dim skCircle As SketchCircle = CType(skEntity, SketchCircle)
				startPt = oApp.TransientGeometry.CreatePoint(skCircle.CenterSketchPoint.Geometry.X, skCircle.CenterSketchPoint.Geometry.Y, 0)
				endPt = startPt
			End If
			' Transform points from sketch space to model space if they are not Nothing
			If startPt IsNot Nothing AndAlso endPt IsNot Nothing Then
				startPt.TransformBy(oSketch.SketchToModelTransform)
				endPt.TransformBy(oSketch.SketchToModelTransform)
				' Check if the points are on any of the face's edges
				Dim onBoundary As Boolean = False
				For Each edge As Edge In faceSelected.Edges
					Dim minDistStart As Double = oApp.MeasureTools.GetMinimumDistance(startPt, Edge)
					Dim minDistEnd As Double = oApp.MeasureTools.GetMinimumDistance(endPt, Edge)
					If minDistStart = 0 AndAlso minDistEnd = 0 Then
						onBoundary = True
						Exit For
					End If
				Next
				' If the entity is on the boundary, add it to the list
				If onBoundary Then
					entitiesOnBoundary.Add(skEntity)
				End If
			End If
		Next
		' Delete all entities that are on the boundary except for projected geometry
		For Each entity In entitiesOnBoundary
			If Not entity.Construction Then ' Assuming 'Construction' property indicates a projected entity
				entity.Delete()
			End If
		Next
		' Commit the transaction
		boundaryCheckTrans.End()
	Catch ex As Exception
		MessageBox.Show("An error occurred while checking boundary entities: " & ex.Message)
		boundaryCheckTrans.Abort() ' Abort transaction on error
	End Try

	' Begin a new transaction to create trimmed lines by redrawing them
	Dim trimTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Create Trimmed Lines")
	Try
		' Attempt to create new lines based on the intersection data
		CreateNewLines(oApp, oPartDef, faceSelected, oSketch, intersectionData)
		trimTrans.End() ' End the transaction to apply the changes
		'		MessageBox.Show("Trimmed lines?", "Title")
	Catch ex As Exception
		MessageBox.Show("An error occurred while trimming the lines: " & ex.Message)
		trimTrans.Abort() ' Abort transaction on error
	Finally
	End Try
	' Get a reference to the TransientGeometry object which is used to create geometry objects
	Dim tg As TransientGeometry = oApp.TransientGeometry
	Dim linesToDelete As New List(Of SketchEntity) ' Modify the type to accommodate different types of sketch entities
	' Iterate over all sketch entities and delete those outside the face boundary
	For Each skEntity As SketchEntity In oSketch.SketchEntities
		Dim startPt As Point = Nothing
		Dim endPt As Point = Nothing
		Dim entityOutsideBoundary As Boolean = False
		If TypeOf skEntity Is SketchLine Then
			Dim skLine As SketchLine = CType(skEntity, SketchLine)
			startPt = oApp.TransientGeometry.CreatePoint(skLine.StartSketchPoint.Geometry.X, skLine.StartSketchPoint.Geometry.Y, 0)
			endPt = oApp.TransientGeometry.CreatePoint(skLine.EndSketchPoint.Geometry.X, skLine.EndSketchPoint.Geometry.Y, 0)
			' Transform points and check boundary
			startPt.TransformBy(oSketch.SketchToModelTransform)
			endPt.TransformBy(oSketch.SketchToModelTransform)
			If Not PointIsOnBoundary(faceSelected, startPt) AndAlso Not PointIsOnBoundary(faceSelected, endPt) Then
				entityOutsideBoundary = True
			End If
		ElseIf TypeOf skEntity Is SketchArc Then
			Dim skArc As SketchArc = CType(skEntity, SketchArc)
			startPt = oApp.TransientGeometry.CreatePoint(skArc.StartSketchPoint.Geometry.X, skArc.StartSketchPoint.Geometry.Y, 0)
			endPt = oApp.TransientGeometry.CreatePoint(skArc.EndSketchPoint.Geometry.X, skArc.EndSketchPoint.Geometry.Y, 0)
			' Transform points and check boundary
			startPt.TransformBy(oSketch.SketchToModelTransform)
			endPt.TransformBy(oSketch.SketchToModelTransform)
			If Not PointIsOnBoundary(faceSelected, startPt) AndAlso Not PointIsOnBoundary(faceSelected, endPt) Then
				entityOutsideBoundary = True
			End If
		ElseIf TypeOf skEntity Is SketchCircle Then
			Dim skCircle As SketchCircle = CType(skEntity, SketchCircle)
			startPt = oApp.TransientGeometry.CreatePoint(skCircle.CenterSketchPoint.Geometry.X, skCircle.CenterSketchPoint.Geometry.Y, 0)
			' Transform the center point and check boundary
			startPt.TransformBy(oSketch.SketchToModelTransform)
			If Not PointIsOnBoundary(faceSelected, startPt) Then
				entityOutsideBoundary = True
			End If
		ElseIf TypeOf skEntity Is SketchSpline Then
			' Immediately delete the spline without checking its position
			Dim skSpline As SketchSpline = CType(skEntity, SketchSpline)
			skSpline.Delete()
			Continue For ' Skip to next entity after handling spline
		End If
		' Delete the entity if it is outside the boundary
		If entityOutsideBoundary Then
			skEntity.Delete()
		End If
	Next

	' Begin a new transaction to check for entities on the boundary and delete them
	Dim boundaryCheckPointTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Check Boundary Entities")
	Try
		Dim entitiesToDelete As New List(Of SketchEntity)
		' Check each entity in the sketch
		For Each skEntity As SketchEntity In oSketch.SketchEntities
			Dim startPt As Point = Nothing
			Dim endPt As Point = Nothing
			Dim onBoundaryStart As Boolean = False
			Dim onBoundaryEnd As Boolean = False
			If TypeOf skEntity Is SketchLine Then
				Dim skLine As SketchLine = CType(skEntity, SketchLine)
				startPt = oApp.TransientGeometry.CreatePoint(skLine.StartSketchPoint.Geometry.X, skLine.StartSketchPoint.Geometry.Y, 0)
				endPt = oApp.TransientGeometry.CreatePoint(skLine.EndSketchPoint.Geometry.X, skLine.EndSketchPoint.Geometry.Y, 0)
			ElseIf TypeOf skEntity Is SketchArc Then
				Dim skArc As SketchArc = CType(skEntity, SketchArc)
				startPt = oApp.TransientGeometry.CreatePoint(skArc.StartSketchPoint.Geometry.X, skArc.StartSketchPoint.Geometry.Y, 0)
				endPt = oApp.TransientGeometry.CreatePoint(skArc.EndSketchPoint.Geometry.X, skArc.EndSketchPoint.Geometry.Y, 0)
			ElseIf TypeOf skEntity Is SketchCircle Then
				Dim skCircle As SketchCircle = CType(skEntity, SketchCircle)
				startPt = oApp.TransientGeometry.CreatePoint(skCircle.CenterSketchPoint.Geometry.X, skCircle.CenterSketchPoint.Geometry.Y, 0)
				endPt = startPt  ' Circles are centered and so have one relevant point
			End If
			' Transform points from sketch space to model space if they are not Nothing
			If startPt IsNot Nothing AndAlso endPt IsNot Nothing Then
				startPt.TransformBy(oSketch.SketchToModelTransform)
				endPt.TransformBy(oSketch.SketchToModelTransform)
				' Check if the points are on any of the face's edges
				onBoundaryStart = PointIsOnBoundary(faceSelected, startPt)
				onBoundaryEnd = PointIsOnBoundary(faceSelected, endPt)
				' If only one of the points is on the boundary and not both, add to delete list
				If (onBoundaryStart Xor onBoundaryEnd) OrElse (Not onBoundaryStart And Not onBoundaryEnd) Then
					entitiesToDelete.Add(skEntity)
				End If
			End If
		Next
		' Delete all entities that are decided to be deleted
		For Each entity In entitiesToDelete
			entity.Delete()
		Next
		' Commit the transaction
		boundaryCheckPointTrans.End()
	Catch ex As Exception
		MessageBox.Show("An error occurred while checking boundary entities: " & ex.Message)
		boundaryCheckTrans.Abort() ' Abort transaction on error
	End Try

	' Start a new transaction for constraint removal
	Dim finalTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Finalize Sketch")
	Try
		' Activate the sketch for editing
		oSketch.Edit()
		' Create lists to hold constraints to delete
		Dim geoConstraints As New List(Of GeometricConstraint)
		Dim dimConstraints As New List(Of DimensionConstraint)
		' Add all constraints to the lists
		For Each gc As GeometricConstraint In oSketch.GeometricConstraints
			geoConstraints.Add(GC)
		Next
		For Each dc As DimensionConstraint In oSketch.DimensionConstraints
			dimConstraints.Add(dc)
		Next
		' Delete all constraints
		For Each gc As GeometricConstraint In geoConstraints
			Try
				GC.Delete()
			Catch ex As Exception
				' Handle the exception if a constraint cannot be deleted
			End Try
		Next
		For Each dc As DimensionConstraint In dimConstraints
			Try
				dc.Delete()
			Catch ex As Exception
				' Handle the exception if a constraint cannot be deleted
			End Try
		Next
		' Commit the transaction
		finalTrans.End()
		' Finish editing the sketch
		oSketch.ExitEdit()
	Catch ex As Exception
		' Handle any errors
		MessageBox.Show("An error occurred: " & ex.Message)
		finalTrans.Abort()
		' Clear the selection
		oApp.ActiveDocument.SelectSet.Clear()
	End Try

	' Now that all constraints are removed, start a new transaction for applying the fix (ground) constraint
	Dim fixTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Apply Ground Constraint")
	Try
		' Apply the ground constraint to each entity in the sketch
		For Each entity As SketchEntity In oSketch.SketchEntities
			' Attempt to apply the ground constraint
			Try
				oSketch.GeometricConstraints.AddGround(entity)
			Catch ex As Exception
			End Try
		Next
		' Commit the transaction
		fixTrans.End()
	Catch ex As Exception
		' Handle any errors
		MessageBox.Show("An error occurred while applying ground constraints: " & ex.Message)
		fixTrans.Abort()
	Finally
		' Clear the selection if necessary
		oApp.ActiveDocument.SelectSet.Clear()
	End Try

	' Start a new transaction to delete all construction entities (like the face border) and points
	Dim deleteConstructionEntitiesAndPointsTrans As Transaction = oApp.TransactionManager.StartTransaction(oDoc, "Delete Construction Entities and Points")
	Try
		' Iterate over the sketch entities using the reverse loop to avoid index issues
		For i2 As Integer = oSketch.SketchEntities.Count - 1 To 0 Step -1
			Dim skEntity As SketchEntity = oSketch.SketchEntities.Item(i2 + 1) ' Collections are 1-based in VBA
			' Check if the entity is marked as construction geometry and not a point (which we will handle separately)
			If Not TypeOf skEntity Is SketchPoint AndAlso skEntity.Construction Then
				skEntity.Delete()
			End If
		Next
		' Now handle points separately because they may fail to delete
		Dim i3 As Integer = oSketch.SketchPoints.Count
		While i3 > 0
			Dim skPoint As SketchPoint = oSketch.SketchPoints.Item(i3)
			Try
				' Attempt to delete the point
				skPoint.Delete()
			Catch ex As Exception
				' If there's an error, log it or ignore it, as the point may not be deletable
			End Try
			i3 -= 1
		End While
		deleteConstructionEntitiesAndPointsTrans.End()  ' Commit the transaction
	Catch ex As Exception
		MessageBox.Show("An error occurred while deleting construction entities and points: " & ex.Message, "Error")
		If deleteConstructionEntitiesAndPointsTrans IsNot Nothing Then
			deleteConstructionEntitiesAndPointsTrans.Abort()  ' Abort transaction on error
		End If
	End Try
	oApp.ActiveDocument.Update2(True)
	oApp.ActiveDocument.SelectSet.Clear()
End Sub




'Functions below
' Function to create intersection points
Public Shared Function CreateIntersectPoints(sk As PlanarSketch, f As Face) As Dictionary(Of SketchLine, List(Of Point2d))
	Dim boundaryList As New List(Of SketchEntity)
	For Each ege As Edge In f.Edges
		Dim se As SketchEntity = sk.AddByProjectingEntity(ege)
		se.Construction = True
		boundaryList.Add(se)
	Next
	Dim pointsOnLine As New Dictionary(Of SketchLine, List(Of Point2d))
	For Each layoutEnt As SketchEntity In sk.SketchEntities
		If boundaryList.Contains(layoutEnt) Then Continue For ' Skip boundary entities
		If TypeOf layoutEnt Is SketchLine Then
			Dim lineA As SketchLine = CType(layoutEnt, SketchLine)
			Dim listOfPoints As New List(Of Point2d)
			For Each boundaryEnt As SketchEntity In boundaryList
				Dim intersections As ObjectsEnumerator = Nothing
				Select Case boundaryEnt.Type
					Case ObjectTypeEnum.kSketchLineObject
						Dim lineB As SketchLine = CType(boundaryEnt, SketchLine)
						intersections = lineA.Geometry.IntersectWithCurve(lineB.Geometry)
					Case ObjectTypeEnum.kSketchSplineObject
						Dim lineB As SketchSpline = CType(boundaryEnt, SketchSpline)
						intersections = lineA.Geometry.IntersectWithCurve(lineB.Geometry)
					Case ObjectTypeEnum.kSketchCircleObject
						Dim lineB As SketchCircle = CType(boundaryEnt, SketchCircle)
						intersections = lineA.Geometry.IntersectWithCurve(lineB.Geometry)
					Case ObjectTypeEnum.kSketchArcObject
						Dim lineB As SketchArc = CType(boundaryEnt, SketchArc)
						intersections = lineA.Geometry.IntersectWithCurve(lineB.Geometry)
				End Select
				If intersections IsNot Nothing AndAlso intersections.Count > 0 Then
					For Each intPoint As Point2d In intersections
						listOfPoints.Add(intPoint)
					Next
				End If
			Next
			If listOfPoints.Count > 0 AndAlso Not pointsOnLine.ContainsKey(lineA) Then
				pointsOnLine.Add(lineA, listOfPoints)
			End If
		End If
	Next
	Return pointsOnLine
End Function
' Function to create new lines
Private Shared Sub CreateNewLines(app As Inventor.Application, def As PartComponentDefinition, f As Face, sk As PlanarSketch, linedata As Dictionary(Of SketchLine, List(Of Point2d)))
	Dim tg As TransientGeometry = app.TransientGeometry
	Try
		For Each kvp As KeyValuePair(Of SketchLine, List(Of Point2d)) In linedata
			Try
				Dim sl As SketchLine = kvp.Key
				Dim intersectionPoints As List(Of Point2d) = kvp.Value
				intersectionPoints.Sort(Function(a, b) tg.CreatePoint2d(sl.StartSketchPoint.Geometry.X, sl.StartSketchPoint.Geometry.Y).DistanceTo(a).CompareTo(tg.CreatePoint2d(sl.StartSketchPoint.Geometry.X, sl.StartSketchPoint.Geometry.Y).DistanceTo(b)))
				Dim allPoints As New List(Of Point2d)(intersectionPoints)
				allPoints.Insert(0, sl.StartSketchPoint.Geometry)
				allPoints.Add(sl.EndSketchPoint.Geometry)
				For i As Integer = 0 To allPoints.Count - 2
					Dim point1 As Point2d = allPoints(i)
					Dim point2 As Point2d = allPoints(i + 1)
					Dim midpoint As Point2d = CalculateMidpoint(app, point1.X, point1.Y, point2.X, point2.Y)
					Dim midpoint3D As Point = tg.CreatePoint(midpoint.X, midpoint.Y, 0)
					midpoint3D.TransformBy(sk.SketchToModelTransform)
					If PointIsOnBoundary(f, midpoint3D) Then
						sk.SketchLines.AddByTwoPoints(point1, point2)
					End If
				Next
				sl.Delete()
			Catch innerEx As Exception
				System.Diagnostics.Debug.WriteLine("Failed processing line: " & innerEx.Message)
			End Try
		Next
	Catch ex As Exception
		System.Diagnostics.Debug.WriteLine("Error in CreateNewLines: " & ex.Message)
		Throw
	End Try
End Sub
' Function to calculate midpoint
Public Shared Function CalculateMidpoint(app As Inventor.Application, x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Point2d
	Dim midX As Double = (x1 + x2) / 2
	Dim midY As Double = (y1 + y2) / 2
	Return app.TransientGeometry.CreatePoint2d(midX, midY)
End Function
' Function to check if point is on boundary (defined as Shared)
Public Shared Function PointIsOnBoundary(f As Face, oPoint As Point) As Boolean
	Dim closestPoint As Point = f.GetClosestPointTo(oPoint)
	Return closestPoint.IsEqualTo(oPoint, 0.0001)
End Function
' Check and delete all splines that might be outside the face boundary
Public Sub CheckAndDeleteSplines(oSketch As PlanarSketch, oApp As Inventor.Application)
	Dim splinesToDelete As New List(Of SketchSpline)
	' Collect all splines that meet certain criteria
	For Each skEntity As SketchEntity In oSketch.SketchEntities
		If TypeOf skEntity Is SketchSpline Then
			' Potentially add checks here based on properties
			Dim skSpline As SketchSpline = CType(skEntity, SketchSpline)
			' For example, check if the spline is marked as construction geometry
			If skSpline.Construction Then
				splinesToDelete.Add(skSpline)
			End If
		End If
	Next
	' Delete collected splines
	For Each spline In splinesToDelete
		spline.Delete()
	Next
	MessageBox.Show("Removed " & splinesToDelete.Count.ToString() & " splines that might be outside the boundary.", "Cleanup Report")
End Sub
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Technology Administrators


Autodesk Design & Make Report