Dim swApp           As Object
Dim Part            As Object
Dim boolstatus      As Boolean
Dim longstatus      As Long, longwarnings As Long
Dim swModel         As modelDoc2

Option Explicit

Dim tmpObj          As SldWorks.modelDoc2
Dim boolstat        As Boolean
Dim Strings         As Variant
Dim swcomponent     As SldWorks.Component2
Dim MateFeature     As SldWorks.feature
Dim FirstSelection  As String
Dim SecondSelection As String
Dim AssemblyName    As String
Dim errors          As Long
Dim warnings        As Long
Dim doc             As SldWorks.modelDoc2

Sub main(oCabineCode As String, SelectedFile As String, TracePath As String)

Set swApp = _
Application.SldWorks

Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2012\templates\Assemblage.asmdot", 0, 0, 0)
Set swModel = swApp.ActivateDoc2(oCabineCode, False, longstatus)
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

longstatus = Part.SaveAs3(SelectedFile, 0, 2)

Set Part = swApp.ActivateDoc2(oCabineCode, False, errors)
Dim TmpTitle As String
TmpTitle = swApp.ActiveDoc.GetTitle
swApp.CloseDoc TmpTitle

Set swApp = Application.SldWorks
    swApp.Visible = True

    ' Get the current working directory before opening the document
    Debug.Print "Current working directory is " & swApp.GetCurrentWorkingDirectory
    Set doc = swApp.OpenDoc6(SelectedFile, swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings)
   
    ' Opening a document with SldWorks::OpenDoc6 does not set the working directory
    Debug.Print "Current working directory is still " & swApp.GetCurrentWorkingDirectory
   
    ' Set the working directory to the document directory
    swApp.SetCurrentWorkingDirectory (Left(doc.GetPathName, InStrRev(doc.GetPathName, "\")))
    Debug.Print "Current working directory is now " & swApp.GetCurrentWorkingDirectory

TmpTitle = swApp.ActiveDoc.GetTitle
Strings = Split(TmpTitle, ".")
AssemblyName = Strings(0)

Set Part = swApp.ActivateDoc2(TmpTitle, True, errors)

'On ouvre le composant (trace) à insérer pour qu'il soit chargé en mémoire
Set tmpObj = swApp.OpenDoc6(TracePath, swDocPART, 0, "", errors, warnings)

Set swModel = swApp.ActivateDoc2(TracePath, False, errors)
Dim TraceName As String
TraceName = swApp.ActiveDoc.GetTitle
Strings = Split(TraceName, ".")
TraceName = Strings(0)

'On Ré-active l'assemblage pour y insérer le composant
Set swModel = swApp.ActivateDoc2(oCabineCode, False, errors)
Set Part = swApp.ActiveDoc

'On ajoute le composant à l'assemblage
boolstatus = Part.Extension.SelectByID2("Point1@Origine", "EXTSKETCHPOINT", 0, 0, 0, True, 1, Nothing, swSelectOptionDefault)
boolstatus = Part.AddComponent(TracePath, 0, 0, 0)
boolstatus = Part.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDisplayOrigins, True)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2(TraceName & "@" & AssemblyName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.UnfixComponent
'Part.ForceRebuild3 True

'On ferme le document pièce puisqu'on n'en a plus besoin
swApp.CloseDoc TracePath

'On sélectionne les entitées qui vont nous servir à créer une contrainte à savoir les deux origines
FirstSelection = "Point1@Origine@" & TraceName & "@" & AssemblyName
SecondSelection = "Point1@Origine"
boolstatus = Part.Extension.SelectByID2(FirstSelection, "EXTSKETCHPOINT", 0, 0, 0, True, 1, Nothing, swSelectOptionDefault)
boolstatus = Part.Extension.SelectByID2(SecondSelection, "EXTSKETCHPOINT", 0, 0, 0, True, 1, Nothing, swSelectOptionDefault)

'On ajoute la contrainte
'Part.FixComponent
Set MateFeature = Part.AddMate3(0, 0, True, 0, 0, 0, 0, 0, 0, 0, 0, False, errors)
'Set MateFeature = swModel.AddMate3(swMateCOINCIDENT, swMateAlignALIGNED, False, 0, 0, 0, 0, 0, 0, 0, 0, False, errors)
'Part.ActivateSelectedFeature

boolstatus = Part.Extension.SelectByID2(TraceName & "@" & AssemblyName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Part.ForceRebuild3 True

Set swModel = swApp.ActivateDoc2(oCabineCode, False, longstatus)
Set Part = swApp.ActiveDoc
Part.ShowNamedView2 "*Isométrique", 7

Part.Save

End Sub