Lesson 5.1 - crank

Files

Associated model(s) Lesson 5.1 - crank

Code

Modules: mMain

'This example uses named entities to get the entities that will be mated
    
'Preconditions: Crank.SLDASM is open
'Results: handle component is mated to arm component
    
'The coincident mate uses the Top Plane of the handle and the arm face
'The concentric mate uses a cylindrical face from the handle and a circular edge from the arm face
    
Option Explicit
    
Public Const strCompPath As String = _
    "C:DropboxBusinessCADSharpAPICoursesAutomating SolidWorks with VBA Macros5- Assemblies5.1 - Creating a new assemblycrankhandle.SLDPRT"
Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public swAssy As SldWorks.AssemblyDoc
Public swArmComp As SldWorks.Component2
Public swHandleComp As SldWorks.Component2
Public swArmFace As SldWorks.Entity
Public swArmEdge As SldWorks.Entity
Public swHandleCylFace As SldWorks.Entity
Public swHandlePlanarFace As SldWorks.Entity
Public swMate As SldWorks.Mate2
Public swComp As SldWorks.Component2
Public swBody As SldWorks.Body2
Public swFace As SldWorks.Face2
Public vComps As Variant
Public vBodies As Variant
Public vFaces As Variant
Public i As Integer
Public j As Integer
Public strAlignment As String
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    
    'Get the arm face by searching components for face called "ArmFace"
    Call GetArmFace
    Set swArmFace = swArmFace.GetSafeEntity
    
    'Get the full circular edge on the arm
    Call GetArmEdge
    
    'Insert the handle
    Call AddComp
    
    'Get a cylindrical face on the handle
    Call GetHandleCylFace
    
    'Get the required planar face on the handle
    Call GetHandlePlanarFace
    
    'Add the mates
    Call AddMates
    
    swModel.ClearSelection2 True
End Sub

Modules: mAddComp

Sub AddComp()
    swApp.DocumentVisible False, swDocPART
    swApp.OpenDoc6 strCompPath, swDocPART, 0, "", Empty, Empty
    Set swHandleComp = swAssy.AddComponent4(strCompPath, "", 0, 0, 0)
    swApp.DocumentVisible True, swDocPART
End Sub

Modules: mAddMates

Sub AddMates()
    Dim lngErrors As Long
    'Add a coincident mate between arm face and handle planar face
    swArmFace.Select4 False, Nothing
    swHandlePlanarFace.Select4 True, Nothing
    Set swMate = swAssy.AddMate3(swMateCOINCIDENT, swMateAlignALIGNED, False, Empty, Empty, _
        Empty, Empty, Empty, Empty, Empty, Empty, False, lngErrors)
    
    'Make sure that arm face and handle face have normals in opposite direction
    Call Alignment
    
    'Add a concentric mate between the edge and cylindrical face
    swArmEdge.Select4 False, Nothing
    swHandleCylFace.Select4 True, Nothing
    swAssy.AddMate3 swMateCONCENTRIC, strAlignment, False, Empty, Empty, Empty, Empty, _
        Empty, Empty, Empty, Empty, False, lngErrors
End Sub

Modules: mAlignment

Dim vNormal As Variant
Dim swTransform As SldWorks.MathTransform
Dim swMathUtil As SldWorks.MathUtility
Dim swMathPt As SldWorks.MathPoint
Dim swMathVect As SldWorks.MathVector
Dim vArmVectData As Variant
Dim vHandleVectData As Variant
    
Sub Alignment()
    Set swMathUtil = swApp.GetMathUtility
    
    'Get normal values for arm planar face
    Set swFace = swArmFace
    Set swComp = swArmFace.GetComponent
    Set swTransform = swComp.Transform2
    vNormal = swFace.Normal
    
    Set swMathPt = swMathUtil.CreatePoint(vNormal)
    Set swMathVect = swMathPt.ConvertToVector
    Set swMathVect = swMathVect.MultiplyTransform(swTransform)
    vArmVectData = swMathVect.ArrayData
    
    'Get normal values for handle planar face
    Set swFace = swHandlePlanarFace
    Set swComp = swHandlePlanarFace.GetComponent
    Set swTransform = swComp.Transform2
    vNormal = swFace.Normal
    
    Set swMathPt = swMathUtil.CreatePoint(vNormal)
    Set swMathVect = swMathPt.ConvertToVector
    Set swMathVect = swMathVect.MultiplyTransform(swTransform)
    vHandleVectData = swMathVect.ArrayData
    
    'Compare the normal values. If they are equal, flip the alignment of the coincident mate
    If Round(vArmVectData(0), 4) = Round(vHandleVectData(0), 4) And _
        Round(vArmVectData(1), 4) = Round(vHandleVectData(1), 4) And _
        Round(vArmVectData(2), 4) = Round(vHandleVectData(2), 4) Then GoTo MateFlip
    Exit Sub
    
MateFlip:
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swFeat As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    Dim swCoinMateFeat As SldWorks.Feature
    
    'This will search assy feature manager tree for last coincident mate and select it
    Set swSelMgr = swModel.SelectionManager
    swModel.Extension.SelectByID2 "Mates", "MATEGROUPS", 0, 0, 0, False, 0, Nothing, 0
    Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
    Set swSubFeat = swFeat.GetFirstSubFeature
    While Not swSubFeat Is Nothing
        If swSubFeat.GetTypeName = "MateCoincident" Then Set swCoinMateFeat = swSubFeat
        Set swSubFeat = swSubFeat.GetNextSubFeature
    Wend
    
    'IAssemblyDoc::EditMate2 requires that we select the two mated entities first with a mark of _
        1, then the the mate itself must be selected last
    Dim swSelData As SldWorks.SelectData
    Set swSelData = swSelMgr.CreateSelectData
    
    swSelData.Mark = 1
    swArmFace.Select4 False, swSelData
    swSelData.Mark = 1
    swHandlePlanarFace.Select4 True, swSelData
    swCoinMateFeat.Select2 True, 0
    
    If swMate.Alignment = swMateAlignALIGNED Then
        strAlignment = swMateAlignANTI_ALIGNED
        swAssy.EditMate2 swMateCOINCIDENT, strAlignment, False, Empty, Empty, Empty, _
            Empty, Empty, Empty, Empty, Empty, Empty
    Else
        strAlignment = swMateAlignALIGNED
        swAssy.EditMate2 swMateCOINCIDENT, strAlignment, False, Empty, Empty, Empty, _
            Empty, Empty, Empty, Empty, Empty, Empty
    End If
End Sub

Modules: mGetArmEdge

Sub GetArmEdge()
    Dim vEdges As Variant
    Dim swEdge As SldWorks.Edge
    
    Set swArmComp = swArmFace.GetComponent
    vBodies = swArmComp.GetBodies3(swSolidBody, Empty)
    Set swBody = vBodies(0)
    vEdges = swBody.GetEdges
    For i = 0 To UBound(vEdges)
        Set swEdge = vEdges(i)
        Set swArmEdge = swEdge
        If swModel.GetEntityName(swArmEdge) = "ArmEdge" Then Exit For
    Next i
    Set swArmEdge = swArmEdge.GetSafeEntity
End Sub

Modules: mGetArmFace

Sub GetArmFace()
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        vBodies = swComp.GetBodies3(swSolidBody, Empty)
        Set swBody = vBodies(0)     'Assume just one body per component
        vFaces = swBody.GetFaces
        For j = 0 To UBound(vFaces)
            Set swFace = vFaces(j)
            Set swArmFace = swFace
            If swModel.GetEntityName(swArmFace) = "ArmFace" Then Exit Sub
        Next j
    Next i
End Sub

Modules: mGetHandleCylFace

Sub GetHandleCylFace()
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        vBodies = swHandleComp.GetBodies3(swSolidBody, Empty)
        Set swBody = vBodies(0)     'Assume just one body per component
        vFaces = swBody.GetFaces
        For j = 0 To UBound(vFaces)
            Set swFace = vFaces(j)
            Set swHandleCylFace = swFace
            If swModel.GetEntityName(swHandleCylFace) = "HandleCylFace" Then Exit Sub
        Next j
    Next i
End Sub

Modules: mGetHandlePlanarFace

Sub GetHandlePlanarFace()
    vComps = swAssy.GetComponents(False)
    For i = 0 To UBound(vComps)
        vBodies = swHandleComp.GetBodies3(swSolidBody, Empty)
        Set swBody = vBodies(0)     'Assume just one body per component
        vFaces = swBody.GetFaces
        For j = 0 To UBound(vFaces)
            Set swFace = vFaces(j)
            Set swHandlePlanarFace = swFace
            If swModel.GetEntityName(swHandlePlanarFace) = "HandlePlanarFace" Then Exit Sub
        Next j
    Next i
End Sub