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
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.
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
Hello
Formidable! Thank you JeromeP. That's exactly it.