Automatic Macro Constraint

Hello

Is it possible to create a macro for the following function:

I would like that by selecting a part "A" or an assembly "B" in an assembly "C", the top plane of "A" or "B" is constrained parallel to the top plane of "C".

Thank you

What is the purpose of the scheme ???

Already at first if the origins were still well placed 

It would help enormously with the assembly

@+

 

We do not work by placement with origins. But during our designs, we make sure to respect, most of the time, the fact that the top plane is horizontal on all our parts and assemblies.

2 solutions to explore:

1- Magnetic constraints (in particular the "ground" constraint which in your case will be the "above" constraint)

see here we talked about it a short time ago: https://www.lynkoa.com/forum/solidworks/contrainte-magn%C3%A9tique-sw?page=0#answer-1027848

2 - or the "Constraint Reference" tool that I use to press my library pieces to the walls.

1 Like

I just tried with the constraint references that don't seem to work.

And I admit that I don't know too much about magnetic constraints. But if it requires work upstream, we will "move" the work.

Oh yes, not said that the constraint reference works in assembly mode. (to be confirmed)

Hello. Try this:

Note: If necessary, replace the names of the assembly and component drawings

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 Likes

Hello

Formidable! Thank you JeromeP. That's exactly it.