This is a mess but it works and only adds a prefix as number. This only works if you run it from within a assembly that contains the assembly you want to copy, and once again yes the code is a mess. But it will give you an idea of what you can do. tweak it and make it your own.
Hello = MessageBox.Show("To use this function a few thing to note" & vbNewLine & " - You use it from the Main Assembly not from the assembly you want to copy"& vbNewLine & " - It doesn't work for assemblys within assemblys","Frametek Ilogic Copy V.1.0", MessageBoxButtons.OKCancel)
'If the messege box ok was selectedf then
If Hello = vbOK Then
'Pick The Assm to Ilogic Copy
Dim PptcasP As Object
PptcasP = ThisServer.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Pick Assm To Copy")
'Cast as Document
Dim Pptc As Document
Pptc = PptcasP.Definition.Document
Dim PptcFFN As String = Right(Pptc.FullDocumentName,(Len(Pptc.FullDocumentName)-(Left(Pptc.FullDocumentName, Len(Pptc.FullDocumentName)).LastIndexOf("\")+1)))
MessageBox.Show(PptcFFN , "Title")
'Ask how many copies they would like
myparam = InputBox("How many times would you like to icopy the assembly?", "How Many Copys?", "1")
'Set Prefix
Dim Prefix As Integer
Prefix = 0
NextF:
Prefix += 1
'Make a Case
Select Case Prefix
Case 1 To myparam
'Selected Assm Save File Location
Dim Slop As String
Slop = Left(Pptc.FullFileName,Len(Pptc.FullFileName)-4) & "" & Prefix & ".iam"
'Check if file exists already
If System.IO.File.Exists(Slop) Then
GoTo NextF:
End If
'Copy Selected
Pptc.SaveAs(Slop,True)
'New Document
Dim NewDoc As Document
NewDoc = ThisApplication.Documents.Open(Slop, False)'Needs to Change to False
'Comp Occurance for "Name"
Dim ComDef As AssemblyComponentDefinition = NewDoc.ComponentDefinition
For Each oOcc As ComponentOccurrence In ComDef.Occurrences
Dim DNoOcc As String = oOcc.Name
'MessageBox.Show(DNoOcc, "Title")
If Right(DNoOcc,2) <> ":1" Then
GoTo CecilsAuntiesFriend
End If
'Get the def and name
Dim oOccFN As String = oOcc.ReferencedDocumentDescriptor.FullDocumentName
Dim Cecil As Document = ThisApplication.Documents.Open(oOccFN,False)
'['Saves Each Ref Doc
'Get Path of Ref Doc
Dim RefDP As String = Cecil.FullFileName
'Get Filename of Cecil by Postion of "\"
Dim PostLC As Integer
PostLC = Left(RefDP, Len(RefDP)).LastIndexOf("\") +2
'File Name(minis ipt or iam)
Dim FNCecil As String
FNCecil = Left(Strings.Mid(RefDP, PostLC), Len(Strings.Mid(RefDP, PostLC)) -4)
'New Name For the Cecils
Dim NewNCecil As String
NewNCecil = FNCecil & "_" & Prefix & ".ipt"
'Make File Path
Dim FPOfDoc As String
FPOfDoc = Left(RefDP, (PostLC - 1)) & NewNCecil
'Check if file exists already
If System.IO.File.Exists(FPOfDoc) Then
GoTo CecilsAuntiesFriend
End If
'Save Part
Cecil.SaveAs(FPOfDoc,True)
']
'Update the refrences of the file using replace
oOcc.Replace(FPOfDoc,True)
Cecil.Close()
CecilsAuntiesFriend:
Next
NewDoc.Update()
NewDoc.Save
NewDoc.Close
GoTo NextF
End Select
End If
