Macro contrainte automatique

Macro
1

Bonjour,

Est-il possible de créer une macro pour la fonction suivante :

Je voudrais qu'en sélectionnant une pièce "A" ou un assemblage "B" dans un assemblage "C", le plan dessus de "A" ou "B" soit contraint parallèle avec le plan dessus de "C".

Merci

2

Quelle est le but de la manipe ???

deja dans un premier temps si les origines étaient toujours bien placés 

ca aiderait énormément à l’assemblage

@+

 

3

Nous ne fonctionnons pas par placement avec les origines. Mais lors de nos conceptions, nous faisons en sorte de respecter, la plupart du temps, le fait que le plan de dessus soit l'horizontale sur toutes nos pièces et assemblages.

4

2 solutions à explorer:

1- Les contraintes magnétiques (en particulier la contrainte "sol" qui sera dans votre cas la contrainte "dessus")

voir ici on en a parlé il y a peu de temps: https://www.lynkoa.com/forum/solidworks/contrainte-magn%C3%A9tique-sw?page=0#answer-1027848

2 - ou l'outil "Référence de contrainte" que j'utilise pour plaquer sur des parois mes pièces de bibliothèque.

1 « J'aime »
5

Je viens d'essayer avec les références de contraintes qui ne semblent pas fonctionner.

Et j'avoue ne pas trop connaitre les contraintes magnétiques. Mais si cela demande du travail en amont, on "déplacera" le travail.

6

ah oui pas dit que la référence de contrainte fonctionne en mode assemblage. (à confirmer)

7

Bonjour. Essaye ca:

Note: Au besoin remplacer les nom des plans de l'assemblage et du composant

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swComp As SldWorks.Component2
    Dim boolstatus As Boolean
    Dim swMate As Mate2
    Dim longstatus As Long
    Dim NomPlanAssy As String
    Dim NomPlanComp As String
    NomPlanAssy = "Plan de dessus"
    NomPlanComp = "Plan de dessus"
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, 0)
    If swComp Is Nothing Then
        MsgBox "Sélectionner une pièce"
        Exit Sub
    End If
    NomPlanComp = NomPlanComp & "@" & swComp.Name2 & "@" & swModel.GetTitle
    If InStr(LCase(swModel.GetTitle), ".sldasm") > 0 Then
        NomPlanComp = Left(NomPlanComp, Len(NomPlanComp) - 7)
    End If
    boolstatus = swModel.Extension.SelectByID2(NomPlanComp, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    boolstatus = swModel.Extension.SelectByID2(NomPlanAssy, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
    Set swMate = swModel.AddMate5(swMateType_e.swMatePARALLEL, swMateAlign_e.swMateAlignALIGNED, False, 0, 0, 0, 0, 0, 0, 0, 0, False, False, 0, longstatus)
    swModel.EditRebuild3
    swModel.ClearSelection2 True
End Sub

 

2 « J'aime »
8

Salut ,

Formidable ! Merci JeromeP. C'est exactement ça.