Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Owner2229
in reply to: Anonymous

Hi, try this one:

 

Dim oDoc As Document = ThisApplication.ActiveDocument
If Not oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
	MsgBox("This rule is for assembly only.")
	Exit Sub
End If
OrigASM = ThisDoc.PathAndFileName(True)
SearchedPart = iProperties.Value("Project", "Part Number")
SearchedPart = InputBox("Please insert prefix of searched parts", "Prefix", DXFName)
If SearchedPart = vbNullString Then
	Exit Sub
End If
NewName = ThisDoc.FileName(False) & " " & iProperties.Value("Project", "Description")
NewName = InputBox("Please insert new number and name for first new assembly", "New ASM name", DXFName)
If NewName = vbNullString Then
	Exit Sub
End If
NewName1 = ThisDoc.FileName(False) & " " & iProperties.Value("Project", "Description")
NewName1 = InputBox("Please insert new number and name for second new assembly", "New ASM name", DXFName)
If NewName1 = vbNullString Then
	Exit Sub
End If
Dim oPath As String = ThisDoc.Path
q1 = MessageBox.Show("Copy to the same location?", "Location",MessageBoxButtons.YesNo)
If q1 = vbNo Then
	Dim dialog1 = New System.Windows.Forms.FolderBrowserDialog()
	dialog1.SelectedPath = oPath
        dialog1.ShowNewFolderButton = True
	If System.Windows.Forms.DialogResult.OK = dialog1.ShowDialog() Then
		oPath = dialog1.SelectedPath
	Else
		MsgBox("No folder selected. Copiyng canceled.")
		Exit Sub
	End If
End If
oPath = oPath & "\"
If oPath = vbNullString Then
	Exit Sub
End If
oDoc.SaveAs(oPath & NewName & ".iam", True)
pDoc = ThisApplication.Documents.Open(oPath & NewName & ".iam")
oDoc = pDoc
Dim acd As ComponentOccurrencesEnumerator = oDoc.ComponentDefinition.Occurrences.AllLeafOccurrences
Dim Occ As ComponentOccurrence
Dim compCount As Integer = oDoc.AllReferencedDocuments.Count * 2
Dim oResult As String
Dim FNamePos As Long
Dim docFName As String
Dim oProgressBar As Inventor.ProgressBar = ThisApplication.CreateProgressBar(False, compCount, "Copiyng assembly", True)
Amount = 100 / compCount
Progress = 0
For Each Occ in acd
	ModelFileName = Occ.Name
	FNamePos = InStrRev(ModelFileName, "\", - 1)
	docFName = Mid(ModelFileName, FNamePos + 1, Len(ModelFileName) - FNamePos)
	oResult = Left(docFName, Len(SearchedPart))
	If oResult <> SearchedPart Then
		Occ.Delete
	End If
	Progress = Progress + 1
	oProgressBar.Message = ("Completed: " & Round(Progress * Amount) & "/" & "100%")
	oProgressBar.UpdateProgress
Next
pDoc = ThisApplication.Documents.Open(OrigASM)
oDoc = pDoc
oDoc.SaveAs(oPath & NewName1 & ".iam", False)
acd = oDoc.ComponentDefinition.Occurrences.AllLeafOccurrences
compCount = oDoc.AllReferencedDocuments.Count
For Each Occ in acd
	ModelFileName = Occ.Name
	FNamePos = InStrRev(ModelFileName, "\", - 1)
	docFName = Mid(ModelFileName, FNamePos + 1, Len(ModelFileName) - FNamePos)
	oResult = Left(docFName, Len(SearchedPart))
        If oResult = SearchedPart Then
		Occ.Delete
        End If
	Progress = Progress + 1
	oProgressBar.Message = ("Completed: " & Round(Progress * Amount) & "/" & "100%")
	oProgressBar.UpdateProgress
Next
oProgressBar.Close

 

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods