Attribute VB_Name = "explodeAssembly"
'       This is a part of the source code for Pro/DESKTOP.
'       Copyright (C) 1999 Parametric Technology Corporation.
'       All rights reserved.

'module for exploding an assembly
'Global object declarations.

Dim app As ProDESKTOP
Dim idMatrix As zMatrix
Dim filename As String
Dim part As PartDocument
Dim unmoved(20) As String
Dim unmovedCount As Integer
Dim subAssembly(20) As aDesignInstance
Dim subAssemblyCount As Integer
Dim helm As helm
Dim matCond As zMatingCondition
Dim matconditions As ObjectSet


Sub DemonstrateAssemblyExplodeRecursive()

'This method explodes the Active Assembly. The assembly should have been saved atleast once
' This method calls the AssemblyExplode method.
' The explotion of the assembly will be carried out on a
' copied part. It is saved in the same directory as the
' given assembly, after appending Exploded to the name.
'    e.g myAssembly.des will  have
'        myAssemblyExploded.des
Set app = CreateObject("ProDESKTOP.Application")
app.SetVisible True

On Error GoTo NoDocErr
Dim doc As GraphicDocument
Set doc = app.GetActiveDoc
If doc Is Nothing Then
    Exit Sub
End If
On Error GoTo 0

If Not (TypeOf doc Is PartDocument) Then
    MsgBox "The Active document is not a Design"
    Exit Sub
End If

Dim design As aDesign
Set design = doc.GetDesign
Dim filename As String
filename = design.GetFile.GetName
If filename = "" Then
    'Design is not yet saved
    MsgBox "Design must be Saved atleast once"
    Exit Sub
End If
    
explodeAssembly filename
Exit Sub

NoDocErr:
    MsgBox "Could not get the Active Design"
    Exit Sub

End Sub

'This subroutine explodes the assembly.
'The assembly name is hardCoded.  Change it if you want to explode different assembly.
'The assembly is exploded based on the assembly constraints.  The operation may not
'be proper if there are no assembly constraints in the assembly.
Sub explodeAssembly(AssemblyName As String)

'Set app = CreateObject("ProDESKTOP.Application")
'app.SetVisible True

'Set helm = app.TakeHelm

'global variable for counting unmoved parts in the firts round.
unmovedCount = 0
subAssemblyCount = 0

'For getting exploded file name..
explodedFileName = GetCopyName(AssemblyName)

'makes a copy of original file to explode.  Always works on a copy of the original part.
FileCopy AssemblyName, explodedFileName
Set part = app.OpenPart(explodedFileName)

Dim design As aDesign
Set design = part.GetDesign

Dim components As ObjectSet
Set components = design.GetComponents
Dim count As Integer
count = components.GetCount()

Dim newSet As ObjectSet
Dim newArray(50) As aDesignInstance
Dim dummyArray(50) As aDesignInstance

GetSortedArray components, newArray

'Create a copy of the array
'This is a read only copy and no processing is done on this copy.
For p = 0 To count - 1
    Set dummyArray(p) = newArray(p)
    name = newArray(p).GetName
Next

'Creates an identity matrix which is used for getting the bounding box for the object.
Set idMatrix = app.GetClass("Matrix").CreateScaleMatrix(1#)

Dim comp As aDesignInstance
Dim objectIndex As Integer
Dim origDes As aDesign
Dim compSet As ObjectSet
Dim compSetCount As Integer

For i = 0 To count - 1

    objectIndex = i
    Set comp = newArray(i)
    
    'This is added for recursively checking the suassmblies
    Set origDes = comp.GetOriginal()
    
    Set compSet = origDes.GetComponents()
    Dim verdict As Boolean
    verdict = compSet.IsEmpty
    If verdict = False Then
        compSetCount = compSet.GetCount()
        Set subAssembly(subAssemblyCount) = comp
        subAssemblyCount = subAssemblyCount + 1
    End If
    
    
    'If there are any mating conditions for this part, break them.
    'This breaks the mating conditions between subassmblies first.
    'Then the subassemblies would be broken.
    ExplodeIt comp, objectIndex, count, dummyArray
    
Next

    'Second pass tries to move the parts which are unmoved in the first pass.
    'This scans through the list of unmoved parts and tries to move them in
    'three axial direction. If there is no interference in a direction, the component
    'will be moved in that direction.
    If unmovedCount > 0 Then
        TrySecondPass dummyArray, count
    End If

If subAssemblyCount > 0 Then
    Dim assy As aDesignInstance
    For p = 0 To subAssemblyCount - 1
        Set assy = subAssembly(p)
        
        'Reset the unmoved count. This will record the unmoved parts for each sub assembly.
        unmovedCount = 0
        
        'replace sub assembly with the copy.
        Set replacedAssy = ReplaceSubAssemblyWithCopy(assy)
        
        Set origDes = replacedAssy.GetOriginal()
        
       ' Dim compSet As ADesignInstance
        Set compSet = origDes.GetComponents()
        compSetCount = compSet.GetCount()
        
        Dim compArray(20) As aDesignInstance
        GetSortedArray compSet, compArray
    
        'This is for testing the mating conditions.  See if you can get
        Dim subComp As aDesignInstance
        Dim matSet As ObjectSet
        Dim normal As zDirection
        Dim revNormal As ZVector
        Dim compIndex As Integer
    
        For q = 0 To compSetCount - 1
            Set subComp = compArray(q)
            compIndex = q
            ExplodeIt subComp, compIndex, compSetCount, compArray
        Next
        
        'For each subassembly, try second pass for unmoved components.
        If unmovedCount > 0 Then
            TrySecondPass dummyArray, count
        End If
    Next
End If

MsgBox ("Done")
 
End Sub

'Checks whether the component is having any interference with any of the
'remaining components. We have to pass the set of all the components in the
'assembly as inpput.
Function CheckInterference(comp As aDesignInstance, index As Integer, count As Integer, dummyArray() As aDesignInstance, intfIndex As Integer)

    Dim dummyComp As aDesign
    Dim intfSet As ObjectSet
    Dim intfBodies As Integer
    Dim originalDes As aDesign
    Set originalDes = comp
                
    For k = 0 To count - 1
        Set dummyComp = dummyArray(k)
            If (k <> index) Then
                intfBodies = originalDes.ComputeInterference(dummyComp, intfSet)
                If (intfBodies > 0) Then
                    intfIndex = k
                    GoTo 100
                End If
            End If
    Next
    intfIndex = -1
100:
    CheckInterference = intfBodies
                
End Function

'Translates a component in the given direction by the distance specified
'movement.
Function TransformComponent(comp As aDesignInstance, direction As ZVector, movement As Double)

    Dim dummyRevMatrix As zMatrix
    Dim dummyRevVector As ZVector
    
    Dim partDoc As PartDocument
    Set partDoc = app.GetActiveDoc
    
    Set dummyRevVector = direction.Multiply(movement)
    Set dummyRevMatrix = app.GetClass("Matrix").CreateTranslationMatrix(dummyRevVector)
    
    comp.transform dummyRevMatrix
    Set helm = app.TakeHelm
    helm.CommitCalls "Update", False
    Set helm = Nothing

End Function

'If there are no mating conditions on the component in the assembly,
'this function will try to move it along three coordinate directions
'and check for interference.  If there is no interference the part
'will be moved in that direction.

Function UnconstrainedComponents(component As aDesignInstance, index As Integer, count As Integer, dummyArray() As aDesignInstance, cMovement As Double, moved As Boolean)

    Dim vecX As ZVector
    Dim vecY As ZVector
    Dim vecZ As ZVector
    Dim intfCheck As Integer
        
    Set vecX = app.CreateVector(1#, 0#, 0#)
    Set vecY = app.CreateVector(0#, 1#, 0#)
    Set vecZ = app.CreateVector(0#, 0#, 1#)
    
    intfCheck = CheckInDir(component, index, count, dummyArray, vecX, cMovement, moved)
    If (intfCheck <> 0) Then
        intfCheck = CheckInDir(component, index, count, dummyArray, vecY, cMovement, moved)
        If (intfCheck <> 0) Then
             intfCheck = CheckInDir(component, index, count, dummyArray, vecZ, cMovement, moved)
        Else
            'MsgBox ("could not move the component")
        End If
    End If

End Function

'Checks whether part can be moved in the direction without any interference.
Function CheckInDir(component As aDesignInstance, index As Integer, count As Integer, dummyArray() As aDesignInstance, dir As ZVector, cMovement As Double, moved As Boolean)

    Dim revDir As ZVector
    Dim interfCheck As Integer
    Dim transMatrix As zMatrix
    Dim coMovement As Double
    Dim moveComp As aDesignInstance
    Dim compt As aDesignInstance
    
    Dim inIndex As Integer
    
    'Check in X direction first.
    TransformComponent component, dir, 0.01
    Set revDir = dir.GetNegative()
                         
    'Check interference for this direction.
    interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
    If interfCheck = 0 Then
        coMovement = GetMaxMovement(component)
        TransformComponent component, dir, coMovement
        
        'Checks whether after moving a part if there is any interface
        interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
        Set compt = component
        If interfCheck > 0 Then
            If moved Then
                'move the parts recursively if there is any interference.
                Do While (inIndex <> -1)
                    Set moveComp = dummyArray(inIndex)
                    coMovement = GetMaxMovement(compt)
                    TransformComponent moveComp, dir, coMovement
                    interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
                    Set compt = moveComp
                Loop
            Else
                TransformComponent component, revDir, (coMovement + 0.01)
                interfCheck = 0
            End If
        End If
        
    Else
        TransformComponent component, revDir, 0.02
        
        interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
        If interfCheck = 0 Then
            coMovement = GetMaxMovement(component)
            TransformComponent component, revDir, coMovement
            
            'Checks whether after moving a part if there is any interface
            interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
            Set compt = component
            If interfCheck > 0 Then
                If moved Then
                    'move the parts recursively if there is any interference.
                    Do While (inIndex <> -1)
                    Set moveComp = dummyArray(inIndex)
                        coMovement = GetMaxMovement(compt)
                        TransformComponent moveComp, revDir, coMovement
                        interfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
                        Set compt = moveComp
                    Loop
                Else
                    TransformComponent component, dir, (coMovement + 0.01)
                    interfCheck = 0
                End If
            End If
        Else
            TransformComponent component, dir, 0.01
        End If
    End If
    CheckInDir = interfCheck

End Function

'Gives the movement direction for component which is used by routine GetMovement
'for getting the desired movement.
Function CheckDirection(dir As ZVector)

    Dim element As Double
    Dim movementDir As Integer
    
    element = dir.GetElement(0)
    If (element = 1#) Then
        movementDir = 1
    Else
        element = dir.GetElement(1)
        If (element = 1#) Then
            movementDir = 2
        Else
            movementDir = 3
        End If
    End If
    
    CheckDirection = movementDir
    
End Function

'Gives the movement for disassembly in the given direction.
Function GetMovement(component As aDesignInstance, trans As zMatrix, direction As ZVector)

    Dim box As zBox
    Set box = component.GetBoundingBox(idMatrix)
    
    Dim movement As Double
    
    Dim moveDir As Integer
    moveDir = CheckDirection(direction)
    
    If moveDir = 1 Then
        movement = box.GetWidth
    End If
    
    If moveDir = 2 Then
        movement = box.GetHeight
    End If
    
    If moveDir = 3 Then
        movement = box.GetDepth
    End If
    
    GetMovement = movement
    
End Function

'Gives the maximum movement for disassembly in the given direction.
Function GetMaxMovement(component As aDesignInstance)

    Dim box As zBox
        
    Set box = component.GetBoundingBox(idMatrix)
    
    Dim movement As Double
    Dim width As Double
    Dim height As Double
    Dim depth As Double
    
    height = box.GetHeight
    depth = box.GetDepth
    width = box.GetWidth
    
    If height > depth Then
        If height > width Then
            movement = height
        Else
            movement = width
        End If
    Else
        If depth > width Then
            movement = depth
        Else
            movement = width
        End If
    End If
        
    GetMaxMovement = movement
    
End Function

'This is a main routine of the example.
'Iterates over the mating conditions on an instance and breaks them if required.
'Transforms the parts based on the mating conditions.
Function ExplodeIt(component As aDesignInstance, index As Integer, count As Integer, dummyArray() As aDesignInstance)
    
        Dim compMovement As Double
        Dim inIndex As Integer
      
        Set matconditions = component.GetMatingConditions
        
        Dim matCount As Integer
        matCount = matconditions.GetCount
        
        Dim bcondFound As Boolean
        
        Dim transVector As ZVector
        Dim transMatrix As zMatrix
        Dim bAbutMoved As Boolean
        Dim normal As zDirection
        Dim revNormal As ZVector
        Dim bMoved As Boolean
          
        'index for mating conditions.
        Dim newIndex As Integer
        
        Dim it As Iterator
        Set it = app.GetClass("It").CreateZObjectIt(matconditions)
        Set matCond = it.start
        
        On Error Resume Next
        While it.IsActive
            bcondFound = matCond.IsA("AbutPlanes")
            newIndex = J
    
            Dim bcenteraxis As Boolean
            bcenteraxis = matCond.IsA("CenterAxes")
            
            'mating condition is mate planes or align planes. We need to break this for movement.
            'this will try moving in normal plane only.
            If bcondFound Then
                Dim abutPlane As zAbutPlanes
                Dim plane As zPlane
                Set abutPlane = matCond
                Dim bAlign As Boolean
                bAlign = abutPlane.IsReversed
              
               'Test for interference and if not proceed.
                'TransformComponent component, dummyRevNormal, 0.01
                ChangeAssemblyConstraint abutPlane, 0.01
                
                Dim interference As Integer
                interference = CheckInterference(component, index, count, dummyArray, inIndex)
                If (interference > 0) Then
                    bInterference = True
'                    Dim reverse As ZVector
'                    Set reverse = dummyRevNormal.GetNegative
'                    TransformComponent component, reverse, 0.01
                    ChangeAssemblyConstraint abutPlane, -0.01
                Else
                    compMovement = GetMaxMovement(component)
                    Dim abutVar As aVariable
                    Set abutVar = abutPlane.GetVariable
                    'TransformComponent component, revNormal, compMovement
                    ChangeAssemblyConstraint abutPlane, compMovement
                    bAbutMoved = True
                    bMoved = True
                    Set helm = app.TakeHelm
                    helm.CommitCalls "Update", False
                    Set helm = Nothing
               End If
               Set tempDes1 = component.GetParent("Design")
               tempDes1.DeleteConstraint matCond
               Set matCond = Nothing
            End If
            
            'If there is only center axes mating condition, then the component
            'will be moved along its axis.
            If (matCount = 1) And bcenteraxis Then
                'To get the centeraxes direction, we get the Parent of the centeraxes matingcondion which will be circular and get its axis
                Set axiscond = matCond
                Dim movDirVect As zDirection
                Dim parentGeom As zGeometry
                Set parentGeom = axiscond.GetOwner.GetGeometry
                Set movDirVect = parentGeom.GetDirection
                Set tempDes2 = component.GetParent("Design")
                tempDes2.DeleteConstraint matCond
                'Delete the centeraxes constraint so that transformation is possible
                Set matCond = Nothing
                compMovement = GetMaxMovement(component)
                TransformComponent component, movDirVect, compMovement
            End If
            
            If (bcenteraxis And (matCount <> 1)) Then 'For centeraxes constraint that escaped the above procedure
                If Not matCond Is Nothing Then
                    Set tempDes3 = component.GetParent("Design")
                    tempDes3.DeleteConstraint matCond
                    Set matCond = Nothing
                    part.UpdateMatingConditions component
                End If
            End If

            'If there is only mate planes or align planes mating condition, then
            'it will be moved in the direction in which there is no interference.
            'This checks for interference in three perpendicular direction one being the normal.
            If (matCount = 1) And bAlign Then
                If bAbutMoved = False Then
                    'CheckPerpDirections component, index, count, dummyArray, compMovement, transMatrix, revNormal
                End If
            End If
            
            'If there are more than one condition and the part is not moved yet
            'the perpendicular directions.
            If (matCount > 1) Then
                
                name = component.GetName
                If bMoved = False And newIndex = (matCount - 1) Then
                    compMovement = GetMaxMovement(component)
                    'CheckPerpDirections component, index, count, dummyArray, compMovement, transMatrix, revNormal
                End If
                
            End If
       
        Set matCond = it.Next
        Wend

        
        'If there is no mating condition on the part, then ckeck for direction
        'of no interference and move it.
        If (matCount = 0) And (index <> 0) Then
            UnconstrainedComponents component, index, count, dummyArray, compMovement, False
            name = component.GetName
        End If
            
End Function

Sub ChangeAssemblyConstraint(mc As zMatingCondition, compMovement As Double)
    Dim matVar As aVariable
    Set matVar = mc.GetVariable
    Dim val As zValue
    Set val = matVar.GetValue
    val.SetUserValue compMovement * 1000
    matVar.SetValue val
End Sub

Function Collapse(compSet As ObjectSet)

    Dim component As aDesignInstance
    Dim objCount As Integer
    Dim fname As String
    Dim cname As String
    Dim transVector As ZVector
    Dim trans As zMatrix
    Dim x1 As Double
    Dim y1 As Double
    Dim z1 As Double
    
    objCount = compSet.GetCount
    
    For i = 1 To objCount - 1
        cname = component.GetName
        
        If Not EOF(2) Then
        
            Input #2, fname, x1, y1, z1
        End If
        If (cname Like fname) Then
            Set transVector = app.CreateVectorXYZ(x1, y1, z1)
            Set trans = app.GetClass("Matrix").CreateTranslationMatrix(transVector)
        
            component.transform trans
            Set helm = app.TakeHelm
            helm.CommitCalls "Update", False
            Set helm = Nothing

        End If
    
    Next
    
    Close #2

End Function

Function RecordForCollapse(component As aDesignInstance, direction As ZVector, movement As Double)

    'Vectors for data file
    Dim dmVector As ZVector
    Dim dmRevVector As ZVector
    Dim name As String
    Dim x As Double
    Dim y As Double
    Dim z As Double
    
    'Write to a file for collapsing
    Set dmVector = direction
    Set dmRevVector = dmVector.GetNegative
    Set dmVector = dmRevVector.Multiply(movement)
    name = component.GetName()
    x = dmVector.GetAt(0)
    y = dmVector.GetAt(1)
    z = dmVector.GetAt(2)
    
 '   Open "e:\ExplodeIt\ExplodeData.txt" For Append As #1
 '   Write #1, name, x, y, z
 '   Close #1
    
End Function

Function CheckPerpDirections(component As aDesignInstance, index As Integer, count As Integer, dummyArray() As aDesignInstance, compMovement As Double, transMatrix As zMatrix, direction As ZVector)

    Dim normalDir As zDirection
    Dim normalDirVect As ZVector
    Dim dummyNormalDir As zDirection
    Set normalDir = direction.GetPerpendicular()
    Set dummyNormalDir = normalDir
    Dim inIndex As Integer
                        
    'Uses vector for transformation.
    Set normalDirVect = app.CreateVectorDir(normalDir, 1)
    TransformComponent component, normalDirVect, 0.01
    
    Dim intfCheck As Integer
    intfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
    If intfCheck = 0 Then
        compMovement = GetMaxMovement(component)
        TransformComponent component, normalDirVect, compMovement
    Else
        Dim reverseDir As ZVector
        Set reverseDir = dummyNormalDir.Negative()
        TransformComponent component, reverseDir, 0.02 'checks in the opposite direction.
                         
        'Check interference for this direction.
        intfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
        If intfCheck = 0 Then
            compMovement = GetMaxMovement(component)
            TransformComponent component, reverseDir, compMovement
        Else
            TransformComponent component, normalDirVect, 0.01
                            
            'Try second perpendicular
            Dim newPerp As ZVector
            Dim dummyNewPerp As ZVector
                                                    
            Set newPerp = direction.Cross(normalDir)
            Set dummyNewPerp = newPerp
                        
            TransformComponent component, newPerp, 0.01
                    
            intfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
            If intfCheck = 0 Then
                compMovement = GetMaxMovement(component)
                TransformComponent component, newPerp, compMovement
            Else
                Dim reverseVect As ZVector
                Set reverseVect = dummyNewPerp.Negative()
                compMovement = GetMaxMovement(component)
                TransformComponent component, reverseVect, 0.02
                                           
                intfCheck = CheckInterference(component, index, count, dummyArray, inIndex)
                If intfCheck = 0 Then
                    compMovement = GetMaxMovement(component)
                    TransformComponent component, reverseVect, compMovement
                Else
                    TransformComponent component, dummyNewPerp, 0.01
                    name = component.GetName()
                    unmoved(unmovedCount) = name
                    unmovedCount = unmovedCount + 1
                End If
            End If
        End If
    End If

End Function

Function CompareElements(first As aDesignInstance, second As aDesignInstance)

    Dim fname As String
    Dim sname As String
    fname = first.GetName
    sname = second.GetName
    Dim comp As Integer
    
    If (second.IsDependentOn(first)) Then
        comp = -1
    Else
        If (first.IsDependentOn(second)) Then
            comp = 1
        Else
            comp = StrComp(fname, sname)
        End If
    End If
    
    CompareElements = comp
  
End Function
'sorts the components for dependancies.
'This helps in finding proper assembly sequence.
Function QuickSortComponents(compArray() As aDesignInstance, left As Integer, right As Integer)
    
    Dim first As aDesignInstance
    Dim second As aDesignInstance
    Dim temp As aDesignInstance

    Dim last As Integer
    Dim tempIndex As Integer
      
    If left >= right Then
        GoTo 200
    End If
        
    'swap elements put here only.
    tempIndex = (left + right) / 2
    Set temp = compArray(left)
    Set compArray(left) = compArray(tempIndex)
    Set compArray(tempIndex) = temp
    
    last = left
    
    Dim comparison As Integer
    For i = (left + 1) To right
        comparison = CompareElements(compArray(i), compArray(left))
        If comparison < 0 Then
            last = last + 1
            Set temp = compArray(last)
            Set compArray(last) = compArray(i)
            Set compArray(i) = temp
        End If
    Next
    
    'swapping of first and last
    Set temp = compArray(left)
    Set compArray(left) = compArray(last)
    Set compArray(last) = temp
    
    QuickSortComponents compArray, left, (last - 1)
    QuickSortComponents compArray, (last + 1), right
         
200:
 
End Function

'normal sort based on the dependency.
'Not used in the module now.  We use quick sort instead.
Function SortComponents(compArray() As aDesignInstance, count As Integer)

    Dim p As Integer
    Dim q As Integer
    
    Dim first As aDesignInstance
    Dim second As aDesignInstance
    Dim temp As aDesignInstance
    
    For p = 0 To count - 1
        For q = 0 To count - 1
            If q <> count - 1 Then
                Set first = compArray(q)
                Set second = compArray(q + 1)
                
                If (first.IsDependentOn(second)) Then
                    Set temp = compArray(q)
                    Set compArray(q) = compArray(q + 1)
                    Set compArray(q + 1) = temp
                End If
            End If
        Next
    Next
End Function

Function ReplaceComponent(component As aDesignInstance, replace As aDesign)

    Dim repMapping As zMatrix
    Dim compMapping As zMatrix
    Dim trans As zMatrix
    Dim partDoc As PartDocument
    Dim File As AObjectFile
    Dim wp As aWorkplane
    Dim tempMat1 As zMatrix
    Dim tempMat2 As zMatrix
    Dim localOrigin As ZVector
    Dim localX As zDirection
    Dim localY As zDirection
    Dim compName As String
    
    Dim planeSet As ObjectSet
    Set planeSet = replace.GetWorkplanes
    Dim planeCount As Integer
    planeCount = planeSet.GetCount
    Dim planeit As Iterator
    Set planeit = app.GetClass("It").CreateAObjectIt(planeSet)
    
    Set dummyPlane = planeit.start
    Dim planeName As String
    
    While planeit.IsActive
       planeName = dummyPlane.GetName
 
        If planeName Like "base" Then
            Set wp = dummyPlane
        End If
        Set dummyPlane = planeit.Next
    Wend
    
    Set localOrigin = wp.GetLocalOrigin
    Set localX = wp.GetLocalX
    Set localY = wp.GetLocalY
    
    Set tempMat1 = app.GetClass("Matrix").CreateTranslationMatrix(localOrigin)
    Set tempMat2 = app.GetClass("Matrix").CreateRotationMatrix(localX, localY)
    
    Set repMapping = tempMat1.MultiplyByMatrix(tempMat2)
    Set repMapping = repMapping.GetInverse()
    
    'find component transformation
    Set planeSet = component.GetWorkplanes
    planeCount = planeSet.GetCount
    
    Set planeit = app.GetClass("It").CreateAObjectIt(planeSet)
    Set dummyPlane = planeit.start
    
    While planeit.IsActive
        planeName = dummyPlane.GetName
        
        If planeName Like "base" Then
            Set wp = dummyPlane
        End If
        Set dummyPlane = planeit.Next
    Wend
    
    Set localOrigin = wp.GetLocalOrigin
    Set localX = wp.GetLocalX
    Set localY = wp.GetLocalY
    
    Set tempMat1 = app.GetClass("Matrix").CreateTranslationMatrix(localOrigin)
    Set tempMat2 = app.GetClass("Matrix").CreateRotationMatrix(localX, localY)
    
    Set compMapping = tempMat1.MultiplyByMatrix(tempMat2)
    Set trans = compMapping.MultiplyByMatrix(repMapping)
    
    compName = component.GetName
    Dim bIsHidden As Boolean
    
    bIsHidden = component.isHidden
    
    Dim thisDes As aDesign
    Set thisDes = part.GetDesign()
    Dim newComp As aDesign
    Dim newCompInstance As aDesignInstance
    
    'Delete the original instance and replace with the copy.
    component.Delete
    Set helm = app.TakeHelm
    helm.CommitCalls "Update", False
    Set helm = Nothing
    
    Set newComp = thisDes.CreateComponent(replace, trans)
    Set newCompInstance = newComp
    newCompInstance.SetName (compName)
    
    newCompInstance.SetHidden (bIsHidden)
    
    Set ReplaceComponent = newCompInstance
    
End Function

Function GetCopyName(name As String)

    Dim strLength As Integer
    strLength = Len(name)

    Dim newString As String
    newString = left(name, (strLength - 4))

    Dim explodedFileName As String
    explodedFileName = newString & "Exploded.des"

    GetCopyName = explodedFileName
    
End Function


Function GetSortedArray(compSet As ObjectSet, tempArray() As aDesignInstance)

    Dim setCount As Integer
    setCount = compSet.GetCount
    
    'initialise the array with the elements
    Dim it As Iterator
    Set it = app.GetClass("It").CreateAObjectIt(compSet)
    p = 0
    Set tempArray(p) = it.start
    p = p + 1
    While it.IsActive
        Set tempArray(p) = it.Next
        p = p + 1
    Wend

    'Call sorting functions. sorts out functions based on dependency
    QuickSortComponents tempArray, 1, setCount - 1
    
    For p = 0 To setCount - 1
        name = tempArray(p).GetName
    Next
    'GetSortedArray = newArray

End Function

Function TrySecondPass(tempArray() As aDesignInstance, count As Integer)

'If there are any unmoved parts in the first round, then try moving them
'in the second round.  If there is any interference in this round, it will not be moved.
 Dim unmovedComp As aDesignInstance
 Dim pname As String
 Dim cMovement As Double
 Dim unmovedIndex As Integer
 If unmovedCount > 0 Then
    For p = 0 To unmovedCount - 1
        cname = unmoved(p)
        For q = 0 To count - 1
            unmovedIndex = q
            Set unmovedComp = tempArray(q)
            pname = unmovedComp.GetName()
            If (pname Like cname) Then
                cMovement = GetMaxMovement(unmovedComp)
                UnconstrainedComponents unmovedComp, unmovedIndex, count, tempArray, cMovement, True
            End If
        Next
    Next
    
End If

End Function


Function ExplodeSubAssembly(compIns As aDesignInstance)
        
    Dim File As AObjectFile
    Set File = origDes.GetFile()
            
    Dim name As String
    name = File.GetName()
            
    Dim subPart As PartDocument
    Dim subPartCopy As PartDocument
            
    Dim copyName As String
    copyName = GetCopyName(name)
            
    FileCopy name, copyName
    
    Set subPartCopy = app.OpenPart(copyName)
            
    Dim subDesign As aDesign
    Set subDesign = subPartCopy.GetDesign()
            
    Dim subComponentSet As ObjectSet
    Set subComponentSet = subDesign.GetComponents()
            
    Dim subCount As Integer
    subCount = subComponentSet.GetCount
            
    Dim subArray As aDesignInstance
    Set sunArray = GetSortedArray(subComponentSet)
            
    Dim it As Iterator
    Set it = app.CreateObjectIt(subComponentSet)
    
    Dim subComp As aDesignInstance
    Set subComp = it.start
    
    While it.IsActive
          ExplodeIt subComp, p, subCount, subArray
          Set subComp = it.Next
    Wend
            
    'Second pass tries to move the parts which are unmoved in the first pass.
    TrySecondPass
            
End Function


Function ReplaceSubAssemblyWithCopy(subAssy As aDesignInstance)

    Dim subFile As AObjectFile
    Dim subFileName As String
    
    Dim subOrigin As aDesign
    Set subOrigin = subAssy.GetOriginal()
    
    Set subFile = subOrigin.GetFile()
    subFileName = subFile.GetName()
    
    Dim copyName As String
    copyName = GetCopyName(subFileName)
    
    Dim subPartTemp As PartDocument
    Dim subPart As PartDocument
    Dim bSave As Boolean
    
    FileCopy subFileName, copyName
    
    Set subPart = app.OpenPart(copyName)
     
    Dim subDesign As aDesign
    Set subDesign = subPart.GetDesign()
    
    Dim newComponent As aDesignInstance
    Set newComponent = ReplaceComponent(subAssy, subDesign)
    
    'Close the subassembly copy.  Only the main assembly and the exploded copy
    'will be open at the end.
    
    Set ReplaceSubAssemblyWithCopy = newComponent
    
End Function