AnsweredAssumed Answered

Auto mate to origin.

Question asked by Willie Roelofs on Aug 28, 2015
Latest reply on Aug 28, 2015 by Willie Roelofs

Hi,

 

Situation: When I start an assembly and drag in the part or assembly into the graphics area, the part or assembly get's fixed in a random spot.

Macro: The macro I've created unfixes the component, selects the planes of that component and the assembly and make every plane coincident. Deletes all the mates and fixes the component.

 

Problem: I don't know how to select the subassembly.

 

Code:

 

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swExt As ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim swAssem As SldWorks.AssemblyDoc
Dim featMgr As SldWorks.FeatureManager
Dim myMate As Object
Dim NaamComp As String
Dim NaamAssy As String
Dim LONGSTATUS As Long
Dim boolstatus As Boolean
Dim FPlane(2) As Variant
Dim TPlane(2) As Variant
Dim RPlane(2) As Variant
Function PlaneMate(Plane1, Plane2, Component As String, Assembly As String) As Boolean
    
    'Select component's plane
    boolstatus = swModel.Extension.SelectByID2(Plane1 & "@" & Component & "@" & Assembly, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
    'Select assembly's plane
    boolstatus = swModel.Extension.SelectByID2(Plane2, "PLANE", 0, 0, 0, True, 1, Nothing, 0)
    'Make planes coincident
    Set myMate = swModel.AddMate5(0, 0, False, 0.382753349352431, 0, 0, 0.001, 0.001, 0, 0.5235987755983, 0.5235987755983, False, False, 0, LONGSTATUS)
    'Selecteren ongedaan maken
    swModel.ClearSelection2 True

End Function
Function DeleteAllMates()
    
    For i = 1 To 25
        'Select mates
        boolstatus = swModel.Extension.SelectByID2("Coincident" & i, "MATE", 0, 0, 0, False, 0, Nothing, 0)
        'Deleting mate
        swModel.EditDelete
    Next i
    
End Function
Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swExt = swModel.Extension
    Set swSelMgr = swModel.SelectionManager
    Set featMgr = swModel.FeatureManager
    Set swAssem = swModel
    
    NaamAssy = swModel.GetTitle
    
    'Look up first component in the list
    vComponents = swAssem.GetComponents(True)
    Set swComp = vComponents(0)
    
    'Select component and make it float.
    boolstatus = swComp.Select2(True, 1)
    NaamComp = swComp.Name2
    swAssem.UnfixComponent
    
    'Every name ever used to name planes.
    FPlane(0) = "Front Plane"
    FPlane(1) = "XY Plane"
    FPlane(2) = "Front"
    RPlane(0) = "Right Plane"
    RPlane(1) = "YZ Plane"
    RPlane(2) = "Right"
    TPlane(0) = "Top Plane"
    TPlane(1) = "XZ Plane"
    TPlane(2) = "Top"
    
    For j = 0 To 2
        For k = 0 To 2
            'Mating the planes
            boolstatus = PlaneMate(FPlane(j), FPlane(k), NaamComp, NaamAssy)
            boolstatus = PlaneMate(RPlane(j), RPlane(k), NaamComp, NaamAssy)
            boolstatus = PlaneMate(TPlane(j), TPlane(k), NaamComp, NaamAssy)
        Next k
    Next j
    
    'Fixating component.
    boolstatus = swComp.Select2(True, 1)
    swAssem.FixComponent

    DeleteAllMates
    
    MsgBox ("Macro voltooid")

End Sub

Outcomes