Bonjour. Pour fixer un sous assemblage avec un nom donné, essaye ca:
Option Explicit
Dim SubName As String
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
SubName = InputBox("Quel est le nom du sous assemblage à fixer?")
TransverseComponents swAssy
End Sub
Sub TransverseComponents(ByVal swAssy As SldWorks.AssemblyDoc)
Dim vComps As Variant
Dim vComp As Variant
Dim swComp As SldWorks.Component2
Dim swModel As SldWorks.ModelDoc2
Dim ModelTitle As String
vComps = swAssy.GetComponents(True)
For Each vComp In vComps
Set swComp = vComp
Set swModel = swComp.GetModelDoc2
If Not swModel Is Nothing Then
ModelTitle = swModel.GetTitle
If InStr(UCase(ModelTitle), ".SLD") > 0 Then ModelTitle = Left(ModelTitle, Len(ModelTitle) - 7)
Debug.Print ModelTitle
If ModelTitle = SubName Then
swComp.Select4 False, Nothing, False
swAssy.FixComponent
End If
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
TransverseComponents swModel
End If
End If
Next
End Sub
Sinon pour fixer le sous-assemblage sélectionner, essaye ca:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.FixComponent
End Sub