Ci-dessous le code, il faut qu'il récupère les 2 objets qui pourtant sont bien selectionnés dans solidworks!
'Option Explicit
'Dim swApp As Object
Dim swApp As SldWorks.SldWorks
'Dim Part As Object
Dim Part As SldWorks.ModelDoc2
Dim Feature As Object
Dim vBody As Variant
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Dim FeatureName As String
Dim filename As String
Dim fileconfig As String
Dim filedispname As String
Dim fileoptions As Long
Dim Filter As String
Dim Piece As String
Dim swModExt As SldWorks.ModelDocExtension
Dim swBody As SldWorks.Body2
Dim sBodySelStr As String
Dim sBodyTypeSelStr As String
Dim i As Long
Dim bRet As Boolean
Dim result As String
Sub Combiner()
'Set swApp = Application.SldWorks
'récupérer l'instance de SolidWorks en cours d'exécution
Set swApp = GetObject(, "SldWorks.Application")
'Permet de voir l'application SolidWorks.
swApp.Visible = True
If swApp Is Nothing Then
Set swApp = CreateObject("SldWorks.Application")
swApp.Visible = True
End If
MsgBox ("Sélection du fichier principal!" & vbCrLf & "Main file selection!")
Filter = "Fichiers Solidworks (*.sldprt; *.sldasm)|*.sldprt;*.sldasm"
'ouvre le fichier père
filename = swApp.GetOpenFilename("Sélection du fichier père", "", Filter, fileoptions, fileconfig, filedispname)
Set Part = swApp.OpenDoc6(filename, 1, 0, "", longstatus, longwarnings)
Set Feature = Part.FirstFeature
While Not Feature Is Nothing
FeatureName = Feature.Name
If Feature.GetTypeName2 = "Stock" Then
Piece = FeatureName
End If
Set Feature = Feature.GetNextFeature()
Wend
'efface le fichier "corps de pièce"
boolstatus = Part.Extension.SelectByID2(Piece, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete
MsgBox ("Sélection de la pièce à soustraire!" & vbCrLf & "Select Part to soustract!")
'ouvre le fichier à soustraire
filename = swApp.GetOpenFilename("Sélection du fichier à soustraire", "", Filter, fileoptions, fileconfig, filedispname)
Set Feature = Part.InsertPart2(filename, 15)
vBody = Part.GetBodies2(swSolidBody, True)
SelectBodies swApp, Part, vBody
'Set Feature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, Nothing, Nothing)
Dim SelMgr As SelectionMgr
Set SelMgr = Part.SelectionManager
Set Feature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, SelMgr.GetSelectedObject6(1, 1), SelMgr.GetSelectedObject6(1, 2))
End Sub
Sub SelectBodies(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vBody As Variant)
If IsEmpty(vBody) Then Exit Sub
Set swModExt = swModel.Extension
For i = 0 To UBound(vBody)
Set swBody = vBody(i)
sBodySelStr = swBody.GetSelectionId
result = sBodySelStr
If InStr(result, ">-<") Then
bRet = swModExt.SelectByID2(result, "SOLIDBODY", 0#, 0#, 0#, True, 2, Nothing, 0)
Else
bRet = swModExt.SelectByID2(result, "SOLIDBODY", 0#, 0#, 0#, True, 1, Nothing, 0)
End If
Next i
End Sub