Extract single Assembly from iAssembly

[Ralf_Krieg]

Hello

I have an iAssembly, with a Sub-iAssembly and iParts. Is it possible to "extract" a copy of one configuration as normal assembly? So that I have an assembly where I can modify parts without touching the iAssembly or iParts.

[philippe.leefsma]

Hi Krieg,

here is a VBA sample:

Private Sub CreateAndMoveiAsmMember()

    Dim factoryDoc As AssemblyDocument
    Set factoryDoc = ThisApplication.Documents.Open("C:\Temp\iAsmFactory.iam")

    Dim factory As iAssemblyFactory
    Set factory = factoryDoc.ComponentDefinition.iAssemblyFactory
    
    Dim row As Long
    row = 1
    
    Dim member As iAssemblyMember
    Call factory.CreateMember(row)

    Dim srcFilename As String
    srcFilename = factory.MemberCacheDir + "\" + factory.TableRows(row).DocumentName
    
    Dim destFilename As String
    destFilename = "C:\Temp\" + "NewMember1.iam"
    
    Call ThisApplication.FileManager.CopyFile(srcFilename, destFilename)
    
    'Delete the original file, if you'd like to
    Call ThisApplication.FileManager.DeleteFile(srcFilename)
    
End Sub

Regards,

Philippe.

[Ralf_Krieg]

Hello

No, i don't want to simple copy a child. I want to make a copy of the factory part and delete the linked table to have a "normal" part. The same i want to do with an iassembly that contains another iassembly and both contains i parts. All of them should be copied and transformed to normal parts and assemblys.

I found a way to do this, but as expected all contraints are gone. That's ok, fixing all occurences is enough.

[philippe.leefsma]

I am not sure what kind of solution you are talking about, could you share it with us?

Thank you,

Philippe.

[Ralf_Krieg]

Hello

Here's the code. Seem's in Inventor 2008 it throws exceptions or tells an iAssembly is an Assembly or an iPart is a Part and so on. In Inventor 2011 it runs fine in every test i made. Without any guarantee

Option Explicit

Private Sub ExtractAssFromiAss()

    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
   
    If oApp.Documents.Count = 0 Then
        MsgBox "An assembly must be open", vbExclamation
        Exit Sub
    End If
   
    If Not oApp.ActiveDocument.DocumentType = kAssemblyDocumentObject Then
        MsgBox "An assembly must be open", vbExclamation
        Exit Sub
    End If
   
    Dim oSourceDoc As AssemblyDocument
    Set oSourceDoc = oApp.ActiveDocument
       
     Dim sBasePath As String
     sBasePath = GetBasePath(oSourceDoc)
   
    Dim sNewFileName As String
    sNewFileName = sBasePath & "\" & GetDocumentName(oSourceDoc) & "-separiert" & Right(oSourceDoc.FullFileName, 4)
   
    Call oSourceDoc.SaveAs(sNewFileName, False)
   
    Dim oNewAss As AssemblyDocument
    Set oNewAss = oSourceDoc 'oApp.Documents.Open(sNewFileName)
                   
    If ProcessRefedDocs(oApp, oNewAss, sBasePath) = False Then
        MsgBox "Error", vbCritical
    End If
   
    Call oNewAss.BrowserPanes.ActivePane.Update
    Call oNewAss.Update2(True)
       
    Call oNewAss.Save2(True)
   
    'Call oNewAss.Close()
   
End Sub


Private Function ProcessRefedDocs(ByVal oApp As Inventor.Application, ByVal oAssDoc As AssemblyDocument, ByVal sBasePath As String) As Boolean

Dim oRefedDoc As Document
Dim oRefedAss As AssemblyDocument
Dim oRefedPart As PartDocument
Dim oNewDoc As Document

Dim oFileSystem As Object

Dim sOldFileName As String
Dim sNewFileName As String

Dim oOcc As ComponentOccurrence

Set oFileSystem = CreateObject("Scripting.FileSystemObject")

For Each oRefedDoc In oAssDoc.ReferencedDocuments
    If oRefedDoc.DocumentType = kAssemblyDocumentObject Then
        'falls es eine iAssembly ist, extrahieren
        Set oRefedAss = oRefedDoc
        sOldFileName = oRefedAss.FullDocumentName
        If oRefedAss.ComponentDefinition.IsiAssemblyMember Then
            sNewFileName = sBasePath & "\" & GetDocumentName(oRefedAss) & "-separiert" & Right(oRefedAss.FullFileName, 4)
            If oFileSystem.FileExists(sNewFileName) = False Then
                Call ExtractiAss(oApp, oRefedAss, sNewFileName)
            End If
           
            If Not sNewFileName = "" Then
                For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
                    If oOcc.ReferencedDocumentDescriptor.FullDocumentName = sOldFileName Then
                        Call oOcc.Replace(sNewFileName, False)
                    End If
                Next
            End If
           
            For Each oNewDoc In oAssDoc.ReferencedDocuments
                If oNewDoc.FullDocumentName = sNewFileName Then
                    Set oRefedAss = oNewDoc
                End If
            Next
        End If
       
        Call processRefedDocs(oApp, oRefedAss, sBasePath) ' subassembly
    ElseIf oRefedDoc.DocumentType = kPartDocumentObject Then
        Set oRefedPart = oRefedDoc
        sOldFileName = oRefedPart.FullDocumentName
        If oRefedPart.ComponentDefinition.IsiPartMember Then
            sNewFileName = sBasePath & "\" & GetDocumentName(oRefedPart) & "-separiert" & Right(oRefedPart.FullFileName, 4)
            If oFileSystem.FileExists(sNewFileName) = False Then
                Call ExtractiPart(oApp, oRefedPart, sNewFileName)
            End If
        ElseIf InStr(oRefedPart.FullDocumentName, "DUMMY") Then
            sNewFileName = sBasePath & "\" & GetDocumentName(oRefedPart) & Right(oRefedPart.FullFileName, 4)
            If oFileSystem.FileExists(sNewFileName) = False Then
                Call oRefedPart.SaveAs(sNewFileName, False)
            End If
        End If
       
        If Not sNewFileName = "" Then
            For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
                If oOcc.ReferencedDocumentDescriptor.FullDocumentName = sOldFileName Then
                    Call oOcc.Replace(sNewFileName, False)
                End If
            Next
        End If
    End If
   
    sNewFileName = ""
Next

ProcessRefedDocs = True

End Function


Private Function GetBasePath(ByVal odoc As Document)

Dim oFileName As String
oFileName = odoc.FullDocumentName

Dim oArray() As String
oArray = Split(oFileName, "\")

Dim sName As String
Dim i As Integer
sName = oArray(LBound(oArray))
For i = 1 To UBound(oArray) - 1
    sName = sName & "\" & oArray(i)
Next
GetBasePath = sName

End Function

Private Function GetDocumentName(ByVal odoc As Document)

Dim oFileName As String
oFileName = odoc.FullDocumentName

Dim oArray() As String
oArray = Split(oFileName, "\")

Dim sName As String
sName = oArray(UBound(oArray))

GetDocumentName = Left(sName, Len(sName) - 4)

End Function


Private Function ExtractiAss(ByVal oApp As Inventor.Application, ByVal oAssDoc As AssemblyDocument, ByVal sNewFileName As String)

Dim oParent As AssemblyDocument
Dim oRow As iAssemblyTableRow
Dim sMemberName As String

sMemberName = oAssDoc.ComponentDefinition.iAssemblyMember.Row.MemberName

Set oParent = oApp.Documents.Open(oAssDoc.ComponentDefinition.iAssemblyMember.ReferencedDocumentDescriptor.FullDocumentName)

Call oParent.SaveAs(sNewFileName, False)

If Not oParent.ComponentDefinition.iAssemblyFactory.DefaultRow.MemberName = sMemberName Then
    For Each oRow In oParent.ComponentDefinition.iAssemblyFactory.TableRows
        If oRow.MemberName = sMemberName Then
            oParent.ComponentDefinition.iAssemblyFactory.DefaultRow = oRow
        End If
    Next
End If

Call oParent.ComponentDefinition.iAssemblyFactory.Delete

Call oParent.Save

oParent.Close

End Function

Private Function ExtractiPart(ByVal oApp As Inventor.Application, ByVal oPartDoc As PartDocument, ByVal sNewFileName As String)

Dim oParent As PartDocument
Dim oRow As iPartTableRow
Dim sMemberName As String

sMemberName = oPartDoc.ComponentDefinition.iPartMember.Row.MemberName

Set oParent = oApp.Documents.Open(oPartDoc.ComponentDefinition.iPartMember.ReferencedDocumentDescriptor.FullDocumentName)

Call oParent.SaveAs(sNewFileName, False)

If Not oParent.ComponentDefinition.iPartFactory.DefaultRow.MemberName = sMemberName Then
    For Each oRow In oParent.ComponentDefinition.iPartFactory.TableRows
        If oRow.MemberName = sMemberName Then
            oParent.ComponentDefinition.iPartFactory.DefaultRow = oRow
        End If
    Next
End If

Call oParent.ComponentDefinition.iPartFactory.Delete

Call oParent.Save

oParent.Close

End Function

[philippe.leefsma]

Well, unfortunately 2008 sounds like an old release already, the development team does not support that many releases back. I'm affraid that if the code works in 2011 and not in 2008, there is very little chance we can help at this time.

Regards,

Philippe.