Insert Multple Bolt

[haphanthanhtam.work]

this is the code for insert Bolt. But it's work for 1 bolt

Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports Inventor
Imports System.Runtime.InteropServices

Dim m_inventorApp As Inventor.Application = Nothing
m_inventorApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")

Dim oAssyDoc As AssemblyDocument
oAssyDoc = m_inventorApp.ActiveDocument

Dim oAssyDef As AssemblyComponentDefinition
oAssyDef = oAssyDoc.ComponentDefinition

' Select a circular edge on the component to be inserted
Dim partEdge As Edge
partEdge = m_inventorApp.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.")

If partEdge Is Nothing Then
Exit Sub
End If

' Get the occurrence of the component that contains the selected edge
Dim Occurrence As ComponentOccurrence
Occurrence = partEdge.Parent.Parent

' Select all the occurrences related to the component that contains the selected edge
Dim tr As TransientObjects
tr = m_inventorApp.TransientObjects

Dim coll As ObjectCollection
coll = tr.CreateObjectCollection()

Dim ac As AssemblyConstraint
For Each ac In Occurrence.Constraints
coll.Add(ac.OccurrenceOne)
coll.Add(ac.OccurrenceTwo)
Next

Dim occ As ComponentOccurrence
For Each occ In coll
oAssyDoc.SelectSet.Select(occ)
Next

' Select a hole on the steel plate to insert the component into
Dim oObject As Object
oObject = m_inventorApp.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select a hole on the steel plate to insert the component into")

If oObject Is Nothing Then
Exit Sub
End If

' Insert the component into the hole on the steel plate
Dim oInsert As InsertConstraint
oInsert = oAssyDef.Constraints.AddInsertConstraint(oObject, partEdge, True, 0)

' Select all the occurrences related to the inserted component
Dim newOccurrence As ComponentOccurrence
newOccurrence = oInsert.OccurrenceTwo
coll.Clear()
For Each ac In newOccurrence.Constraints
coll.Add(ac.OccurrenceOne)
coll.Add(ac.OccurrenceTwo)
Next

For Each occ In coll
oAssyDoc.SelectSet.Select(occ)
Next

' Select all the occurrences related to the copied and pasted component
Dim pasteOccurrence As ComponentOccurrence
pasteOccurrence = oAssyDef.Occurrences.Item(oAssyDef.Occurrences.Count)
coll.Clear()
For Each ac In pasteOccurrence.Constraints
coll.Add(ac.OccurrenceOne)
coll.Add(ac.OccurrenceTwo)
Next

For Each occ In coll
oAssyDoc.SelectSet.Select(occ)
Next

InventorVb.DocumentUpdate()

[Andrii_Humeniuk · Accepted solution]

Hi @haphanthanhtam.work . If you wanted your rule to automatically place a bolt in all holes, then try this rule:

Sub main()
	Dim oDoc As Document = ThisDoc.Document
	If Not TypeOf oDoc Is AssemblyDocument Then Exit Sub
	Dim oAsmDoc As AssemblyDocument = oDoc
	Dim oAsmDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
	Dim partEdge, oObj, oNewEdge As Edge
	Dim oCM As CommandManager = ThisApplication.CommandManager
	partEdge = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.")
	If partEdge Is Nothing Then Exit Sub
	If partEdge.Parent.Parent.Constraints.Count > 0 Then Exit Sub
	Dim bQuest As Boolean = True
	Dim oInsert As InsertConstraint
	Do
		oObj = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a hole on the steel plate to insert the component into")
		If oObj Is Nothing Then Exit Sub
		Dim oObjCircle As Circle = oObj.Geometry
		If bQuest Then
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, partEdge, True, 0)
		Else
			oNewEdge = GetNewOccEdge(oAsmDef, partEdge)
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, oNewEdge, True, 0)
		End If
		If bQuest Then
			Dim oColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection()
			For i As Integer = 1 To oObj.Faces.Count
				If oObj.Faces(i).SurfaceType = SurfaceTypeEnum.kPlaneSurface Then
					For iEdge As Integer = 1 To oObj.Faces(i).Edges.Count
						If oObj.Faces(i).Edges(iEdge).GeometryType = CurveTypeEnum.kCircleCurve Then
							If oObj.Faces(i).Edges(iEdge).Geometry.Radius = oObjCircle.Radius Then oColl.Add(oObj.Faces(i).Edges(iEdge))
						End If
					Next iEdge
					Exit For
				End If
			Next i
			boxYes = MessageBox.Show("You want To place the bolt In all the holes (" & oColl.Count & ")?", _
								"Insert Multple Bolt", MessageBoxButtons.YesNo, MessageBoxIcon.Question, _
								MessageBoxDefaultButton.Button1)
			If boxYes = vbYes Then
				For i As Integer = 1 To oColl.Count
					If oColl(i) Is oObj Then Continue For
					oNewEdge = GetNewOccEdge(oAsmDef, partEdge)
					oInsert = oAsmDef.Constraints.AddInsertConstraint(oColl(i), oNewEdge, True, 0)
				Next i
				Exit Do
			Else
				bQuest = False
			End If
		End If
	Loop
	oAsmDoc.Update()
End Sub

Private Function GetNewOccEdge(oAsmDef As AssemblyComponentDefinition, partEdge As Edge) As Edge
	Dim oPartDoc As PartDocument = partEdge.Parent.Parent.Definition.Document
	Dim oMatrix As Matrix = ThisApplication.TransientGeometry.CreateMatrix()
	oNewOcc = oAsmDef.Occurrences.Add(oPartDoc.FullDocumentName, oMatrix)
	For iBody As Integer = 1 To oNewOcc.SurfaceBodies.Count
		If oNewOcc.SurfaceBodies(iBody).Name = partEdge.Parent.Name Then
			For iEdge As Integer = 1 To oNewOcc.SurfaceBodies(iBody).Edges.Count
				If oNewOcc.SurfaceBodies(iBody).Edges(iEdge).TransientKey = partEdge.TransientKey Then
					Return oNewOcc.SurfaceBodies(iBody).Edges(iEdge)
				End If
			Next iEdge
		End If
	Next iBody
	Return Nothing
End Function

 I completely rewrote your rule.

[haphanthanhtam.work]

Hi @Andrii_Humeniuk 

It works with a single Part, but it does not work with multiple constrained Parts or an Sub-Assembly.
How does it work with all problems

[haphanthanhtam.work]

Hi @Andrii_Humeniuk 
Can you try it. This file 

[haphanthanhtam.work]

Hi  @Andrii_Humeniuk 
from your generated code is it possible to convert it a bit

[Andrii_Humeniuk]

Hi @haphanthanhtam.work . AxesOpposed = False

[haphanthanhtam.work]

Sorry
Can you wirte a code for me replace it!! 😥

[Andrii_Humeniuk · Accepted solution]

No problem. I changed lines 18, 21 and 42.

Sub main()
	Dim oDoc As Document = ThisDoc.Document
	If Not TypeOf oDoc Is AssemblyDocument Then Exit Sub
	Dim oAsmDoc As AssemblyDocument = oDoc
	Dim oAsmDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
	Dim partEdge, oObj, oNewEdge As Edge
	Dim oCM As CommandManager = ThisApplication.CommandManager
	partEdge = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.")
	If partEdge Is Nothing Then Exit Sub
'	If partEdge.Parent.Parent.Constraints.Count > 0 Then Exit Sub
	Dim bQuest As Boolean = True
	Dim oInsert As InsertConstraint
	Do
		oObj = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a hole on the steel plate to insert the component into")
		If oObj Is Nothing Then Exit Sub
		Dim oObjCircle As Circle = oObj.Geometry
		If bQuest Then
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, partEdge, False, 0)
		Else
			oNewEdge = GetNewOccEdge(oAsmDef, partEdge)
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, oNewEdge, False, 0)
		End If
		If bQuest Then
			Dim oColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection()
			For i As Integer = 1 To oObj.Faces.Count
				If oObj.Faces(i).SurfaceType = SurfaceTypeEnum.kPlaneSurface Then
					For iEdge As Integer = 1 To oObj.Faces(i).Edges.Count
						If oObj.Faces(i).Edges(iEdge).GeometryType = CurveTypeEnum.kCircleCurve Then
							If oObj.Faces(i).Edges(iEdge).Geometry.Radius = oObjCircle.Radius Then oColl.Add(oObj.Faces(i).Edges(iEdge))
						End If
					Next iEdge
					Exit For
				End If
			Next i
			boxYes = MessageBox.Show("You want To place the bolt In all the holes (" & oColl.Count & ")?", _
								"Insert Multple Bolt", MessageBoxButtons.YesNo, MessageBoxIcon.Question, _
								MessageBoxDefaultButton.Button1)
			If boxYes = vbYes Then
				For i As Integer = 1 To oColl.Count
					If oColl(i) Is oObj Then Continue For
					oNewEdge = GetNewOccEdge(oAsmDef, partEdge)
					oInsert = oAsmDef.Constraints.AddInsertConstraint(oColl(i), oNewEdge, False, 0)
				Next i
				Exit Do
			Else
				bQuest = False
			End If
		End If
	Loop
	oAsmDoc.Update()
End Sub

Private Function GetNewOccEdge(oAsmDef As AssemblyComponentDefinition, partEdge As Edge) As Edge
	Dim oPartDoc As PartDocument = partEdge.Parent.Parent.Definition.Document
	Dim oMatrix As Matrix = ThisApplication.TransientGeometry.CreateMatrix()
	oNewOcc = oAsmDef.Occurrences.Add(oPartDoc.FullDocumentName, oMatrix)
	For iBody As Integer = 1 To oNewOcc.SurfaceBodies.Count
		If oNewOcc.SurfaceBodies(iBody).Name = partEdge.Parent.Name Then
			For iEdge As Integer = 1 To oNewOcc.SurfaceBodies(iBody).Edges.Count
				If oNewOcc.SurfaceBodies(iBody).Edges(iEdge).TransientKey = partEdge.TransientKey Then
					Return oNewOcc.SurfaceBodies(iBody).Edges(iEdge)
				End If
			Next iEdge
		End If
	Next iBody
	Return Nothing
End Function

[haphanthanhtam.work]

Thanks @Andrii_Humeniuk  !!!

[yuzeaa · Accepted solution]

Hi, @haphanthanhtam.work 

I made some modifications to @Andrii_Humeniuk's  code to make it work for multiple constrained Parts.

Sub main()
	Dim oDoc As Document = ThisDoc.Document
	If Not TypeOf oDoc Is AssemblyDocument Then Exit Sub
	Dim oAsmDoc As AssemblyDocument = oDoc
	Dim oAsmDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
	Dim partEdge, oObj, oNewEdge As Edge
	Dim oCM As CommandManager = ThisApplication.CommandManager
	partEdge = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a circular edge.")
	If partEdge Is Nothing Then Exit Sub
	
    GetMultiOcc(partEdge.Parent.Parent)
    MultiOccs = ThisApplication.TransientObjects.CreateObjectCollection
	occlist.ForEach(Function(entity) MultiOccs.Add(entity))
	oDoc.SelectSet.SelectMultiple(MultiOccs)
	ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd").Execute() 'ctrl+c MultiOccs	
    oDoc.SelectSet.clear

	Dim bQuest As Boolean = True
	Dim oInsert As InsertConstraint
	Do
		oObj = oCM.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select a hole on the steel plate to insert the component into")
		If oObj Is Nothing Then Exit Sub
		Dim oObjCircle As Circle = oObj.Geometry
		If bQuest Then
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, partEdge, True, 0)
		Else
			ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute()
			oNewEdge = GetNewOccEdge(GetNewOcc(oAsmDef,partEdge), partEdge)
			oInsert = oAsmDef.Constraints.AddInsertConstraint(oObj, oNewEdge, True, 0)
		End If
		If bQuest Then
			Dim oColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection()
			For i As Integer = 1 To oObj.Faces.Count
				If oObj.Faces(i).SurfaceType = SurfaceTypeEnum.kPlaneSurface Then
					For iEdge As Integer = 1 To oObj.Faces(i).Edges.Count
						If oObj.Faces(i).Edges(iEdge).GeometryType = CurveTypeEnum.kCircleCurve Then
							If oObj.Faces(i).Edges(iEdge).Geometry.Radius = oObjCircle.Radius Then oColl.Add(oObj.Faces(i).Edges(iEdge))
						End If
					Next iEdge
					Exit For
				End If
			Next i
			boxYes = MessageBox.Show("You want To place the bolt In all the holes (" & oColl.Count & ")?", _
								"Insert Multple Bolt", MessageBoxButtons.YesNo, MessageBoxIcon.Question, _
								MessageBoxDefaultButton.Button1)
			If boxYes = vbYes Then
				For i As Integer = 1 To oColl.Count
					If oColl(i) Is oObj Then Continue For
	                ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute()
					oNewEdge = GetNewOccEdge(GetNewOcc(oAsmDef,partEdge), partEdge)
					oInsert = oAsmDef.Constraints.AddInsertConstraint(oColl(i), oNewEdge, True, 0)
				Next i
				Exit Do
			Else
				bQuest = False
			End If
		End If
	Loop
	oAsmDoc.Update()
End Sub

Private Function GetNewOcc(oAsmDef As AssemblyComponentDefinition,partEdge As Edge) As ComponentOccurrence
	Dim oPartDoc As PartDocument = partEdge.Parent.Parent.Definition.Document			
	For i = oAsmDef.Occurrences.Count To oAsmDef.Occurrences.Count - occlist.count Step -1
		If oAsmDef.Occurrences(i).Definition.Document.FullDocumentName = oPartDoc.FullDocumentName Then
			Return oAsmDef.Occurrences(i)
	        Exit Function
		End If 
	Next 
End Function

Private Function GetNewOccEdge(oNewOcc As ComponentOccurrence, partEdge As Edge) As Edge
	Dim oPartDoc As PartDocument = partEdge.Parent.Parent.Definition.Document
	For iBody As Integer = 1 To oNewOcc.SurfaceBodies.Count
		If oNewOcc.SurfaceBodies(iBody).Name = partEdge.Parent.Name Then
			For iEdge As Integer = 1 To oNewOcc.SurfaceBodies(iBody).Edges.Count
				If oNewOcc.SurfaceBodies(iBody).Edges(iEdge).TransientKey = partEdge.TransientKey Then
					Return oNewOcc.SurfaceBodies(iBody).Edges(iEdge)
				End If
			Next iEdge
		End If
	Next iBody
	Return Nothing
End Function

Dim occlist As New List(Of ComponentOccurrence)

Private Sub GetMultiOcc(occ As ComponentOccurrence) 
	occlist.Add(occ)
	Dim InsertConstraints As New List(Of InsertConstraint)
	InsertConstraints = occ.Constraints.OfType(Of InsertConstraint).ToList()
	If InsertConstraints.Count = 0 Then 
		Exit Sub
	Else
		For Each InsertConstraint As InsertConstraint In InsertConstraints
			Dim occ1 = InsertConstraint.OccurrenceOne
			If occ1.name <> occ.Name AndAlso Not occlist.contains(occ1)Then GetMultiOcc(occ1)
			Dim occ2 = InsertConstraint.OccurrenceTwo
			If occ2.name <> occ.Name  AndAlso Not occlist.contains(occ2)Then GetMultiOcc(occ2)
		Next
	End If 
End Sub

[haphanthanhtam.work]

Thanks @yuzeaa so much