Sub Main() Dim g_App As Inventor.InventorServer = ThisApplication Dim oDoc As Document = ThisApplication.ActiveDocument If Not oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then MsgBox("This rule is for assembly only.") Exit Sub End If Dim OrigASM As String = ThisDoc.PathAndFileName(True) Dim oPath As String = ThisDoc.Path & "\" 'SearchedPartExample = "RUCW001;RUCW002;RUCW003" SearchedPart = InputBox("Please insert stock number of searched parts", "Input") If SearchedPart = vbNullString Then Exit Sub End If 'specify word splitting character ";" Dim Separators() As Char = {";"c} oStockNumbers = SearchedPart.Split(Separators) i = 0 For Each oStockNR In oStockNumbers Dim oNewAsmDoc(i) As AssemblyDocument oNewAsmDoc(i) = g_App.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject, , True) Call LookForStockNR(oDoc, oStockNumbers(i), oNewAsmDoc(i)) i += 1 Next oDoc.Activate End Sub Sub LookForStockNR(oDoc As Document, oStockNR As String, oNewDoc As AssemblyDocument) Dim refDocs As DocumentsEnumerator = oDoc.AllReferencedDocuments Dim refDoc As Document For Each refDoc in refDocs ModelFileName = refDoc.FullFileName FNamePos = InStrRev(ModelFileName, "\", - 1) docFName = Mid(ModelFileName, FNamePos + 1, Len(ModelFileName) - FNamePos) If iProperties.Value(docFName, "Project", "Stock Number") = oStockNR Then Call AddOccurrence(oNewDoc, ModelFileName) End If Next End Sub Sub AddOccurrence(oNewDoc As AssemblyDocument, oPartToAdd As String) Dim oAsmCompDef As AssemblyComponentDefinition = oNewDoc.ComponentDefinition Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Dim oMatrix As Matrix = oTG.CreateMatrix Call oMatrix.SetToRotation(3.14159265358979 / 4, _ oTG.CreateVector(0, 0, 1), oTG.CreatePoint(0, 0, 0)) Call oMatrix.SetTranslation(oTG.CreateVector(3, 2, 1)) Dim oOcc As ComponentOccurrence oOcc = oAsmCompDef.Occurrences.Add(oPartToAdd, oMatrix) End Sub