9 Replies Latest reply on Jul 20, 2017 11:49 AM by Korbi Anis

    CHECK INTERFERENCE BETWEEN TWO FACES

    Korbi Anis

      Hello friends ; I have two faces in assembly and I would like to check interferences between them.ere there a method to do this . thank you very much

        • Re: CHECK INTERFERENCE BETWEEN TWO FACES
          Korbi Anis

          Thank you dear friend sfor your answer.However this function detect interferences between just component  not faces only !

            • Re: CHECK INTERFERENCE BETWEEN TWO FACES
              Korbi Anis

              Thanks dear Ivana for uou answer. I wrote a macro to detect iterference between two face but alway there are a crash of solidworks ! it closed automaticaly when I try to run the macro !

                • Re: CHECK INTERFERENCE BETWEEN TWO FACES
                  Ivana Kolin

                  without seeing your macro is hard to tell why is it crashing.

                    • Re: CHECK INTERFERENCE BETWEEN TWO FACES
                      Korbi Anis

                      this is the macro:

                       

                       

                      Sub SELPOINTANDMAKECOINCIDENT()

                       

                       

                       

                       

                      Dim swApp As SldWorks.SldWorks

                      Dim swModel As SldWorks.ModelDoc2

                      Dim boolstatus As Boolean

                      Dim swSelMgr As SldWorks.SelectionMgr

                      Dim swFeat As SldWorks.Feature

                      Dim swSketch As SldWorks.Sketch

                      Dim swPOINT As SldWorks.SketchPoint

                      Dim swPTT As Object

                      Dim swFA As SldWorks.Face2

                      Dim i As Integer

                      Dim vPoint As Variant

                      Dim vP1 As Variant

                          Dim vP2 As Variant

                      Dim nDist(20) As Variant

                      Dim First As Integer, Last As Long

                          Dim j As Long

                          Dim Temp As Double

                          Dim p As Integer

                          Dim a, b, c, d, e, f, g, h, II As Integer

                         

                         

                       

                       

                       

                       

                       

                       

                          Set swApp = Application.SldWorks

                          Set swModel = swApp.ActiveDoc

                          Set swModelDocExt = swModel.Extension

                          Set swSelMgr = swModel.SelectionManager

                          boolstatus = swModelDocExt.SelectByID2("MESHPOINT4@P VERT-2@Assemblage2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

                          Set swFeat = swSelMgr.GetSelectedObject6(1, -1)

                          Set swSketch = swFeat.GetSpecificFeature2

                          vPoint = swSketch.GetSketchPoints

                          swModel.ClearSelection2 True

                       

                           

                          If IsEmpty(vPoint) Then Exit Sub

                           

                          For i = 0 To UBound(vPoint)

                              Set swPOINT = vPoint(i)

                              swPOINT.Select4 True, Nothing

                              Set swPTT = swSelMgr.GetSelectedObject6(1, -1)

                              '================================================ select face rouge =====================================================

                              Set swApp = Application.SldWorks

                      Set swModel = swApp.ActiveDoc

                      Set swAssy = swModel

                      Set swSelMgr = swModel.SelectionManager

                      Set swSelData = swSelMgr.CreateSelectData

                       

                       

                      Set swComp = swAssy.GetComponentByName("P ROUGE-4")

                      Set swBody = swComp.GetBody

                      If (swBody Is Nothing) Then

                      swApp.SendMsgToUser "Component Body Unavailable."

                      swApp.SendMsgToUser "Make sure not lightweight or suppressed"

                      Exit Sub

                      End If

                      Set swFace = swBody.GetFirstFace

                      Do While Not swFace Is Nothing

                      sCurFaceName = swModel.GetEntityName(swFace)

                      If sCurFaceName Like "3" & "*" Then

                      Set swEnt = swFace

                      swSelData.Mark = 1

                      bRet = swEnt.Select4(True, swSelData)

                       

                       

                      End If

                      Set swFace = swFace.GetNextFace

                      Loop

                      Set swFA = swSelMgr.GetSelectedObject6(2, -1)

                       

                       

                      '=======================================================COINDENTE MATE  ==================================

                      '----------------------------------------------MAKE COINCIDENTE MATES ' ------------------------------------------------------------'

                        

                      Set matefeature = swAssy.AddMate3(swMateCOINCIDENT, swMateAlignCLOSEST, False, 0, 0, 0, 0, 0, 0, 0, 0, False, ErrorLong)

                      matefeature.name = "COINCIDENCE31"   ' RENAME THE MATE AS I LIKE ' ITS MY SPACIAL NAME INPUT'

                      If swAddMateError_OverDefinedAssembly = ErrorLong Then

                      MsgReply = MsgBox("Overdefining mate.  Keep anyway?", vbYesNo + vbQuestion)

                      If vbNo = MsgReply Then

                      swModel.ClearSelection2 True

                      matefeature.Select True

                      swModel.Extension.DeleteSelection2 0

                      End If

                      Else

                      'swModel.EditRebuild3

                      End If

                      If swAddMateError_OverDefinedAssembly = ErrorLong Then

                      MsgBox (" ILA YA PAS UNE CONTRAINTE")

                       

                       

                      Else

                      MsgBox (" YA UNE CONTRAINTE")

                      swModel.ClearSelection2 True

                      swModel.FeatureManager.UpdateFeatureTree

                       

                       

                      '------------------------------------------- VERIFICATION DES INTERFERENCES----------------------------------'

                       

                       

                         

                          Dim swConfMgr                   As SldWorks.ConfigurationManager

                          Dim swConf                      As SldWorks.Configuration

                          Dim swRootComp                  As SldWorks.Component2

                          Dim StartTime                   As Double

                          Dim FinishTime                  As Double

                          Dim TotalTime                   As Double

                         

                            Dim vChildComp                  As Variant

                          Dim swChildComp                 As SldWorks.Component2

                          Dim sPadStr                     As String

                       

                       

                          

                            Dim swSubFeat                   As SldWorks.Feature

                          Dim swSubSubFeat                As SldWorks.Feature

                          Dim swSubSubSubFeat             As SldWorks.Feature

                      Dim nLevel As Long

                       

                       

                          Dim LO As Integer

                         

                          Set swApp = CreateObject("SldWorks.Application")

                          Set swModel = swApp.ActiveDoc

                          Set swConfMgr = swModel.ConfigurationManager

                          Set swConf = swConfMgr.ActiveConfiguration

                          Set swRootComp = swConf.GetRootComponent3(True)

                          StartTime = Timer ' Start time

                          Debug.Print "File = " & swModel.GetPathName

                          TraverseModelFeatures swModel, 1

                          If swModel.GetType = SwConst.swDocASSEMBLY Then

                              TraverseComponent swRootComp, 1

                       

                       

                          End If

                          FinishTime = Timer ' End time

                          TotalTime = FinishTime - StartTime ' Elapsed time

                          Debug.Print ("Time = " & TotalTime & " sec")

                        '=========================================================================================================================

                      Set swApp = Application.SldWorks

                      Set swModel = swApp.ActiveDoc

                      Set swAssy = swModel

                      Set swSelMgr = swModel.SelectionManager

                      Set swSelData = swSelMgr.CreateSelectData

                       

                       

                      Set swComp = swAssy.GetComponentByName("P ROUGE-4")

                      Set swBody = swComp.GetBody

                      If (swBody Is Nothing) Then

                      swApp.SendMsgToUser "Component Body Unavailable."

                      swApp.SendMsgToUser "Make sure not lightweight or suppressed"

                      Exit Sub

                      End If

                      Set swFace = swBody.GetFirstFace

                      Do While Not swFace Is Nothing

                      sCurFaceName = swModel.GetEntityName(swFace)

                      If sCurFaceName Like "3" & "*" Then

                      Set swEnt = swFace

                      swSelData.Mark = 2

                      bRet = swEnt.Select4(True, swSelData)

                       

                       

                      End If

                      Set swFace = swFace.GetNextFace

                      Loop

                       

                       

                       

                       

                       

                       

                       

                       

                      '=================================================================================================================================

                       

                       

                          Set swModel = swApp.ActiveDoc

                          Set swAssy = swModel

                          Set swSelMgr = swModel.SelectionManager

                          Set swSelData = swSelMgr.CreateSelectData

                          Debug.Print "File = " & swModel.GetPathName

                          nSelCount = swSelMgr.GetSelectedObjectCount

                          ReDim CompArray(nSelCount - 1)

                          Debug.Print "Number of selected components: " & nSelCount

                          For k = 0 To (nSelCount - 1)

                              Set CompArray(k) = swSelMgr.GetSelectedObjectsComponent2(k + 1)

                              Debug.Print "  Comp[" & k & "] = " & CompArray(k).Name2

                          Next k

                          vCompArray = CompArray

                          swAssy.ToolsCheckInterference2 nSelCount, (vCompArray), bCoincidentInterference, vIntCompArray, vIntFaceArray   !!!!!!!!!!!!!!!!!!!  (THE PROBLEM IS HERE , CRASHHHHH !! )

                          If Not IsEmpty(vIntFaceArray) Then

                              Debug.Print "    " & UBound(vIntFaceArray) + 1 & " faces interfere!"

                              MsgBox ("INTERFERENCE!!!!!!!!!!!!!!!")

                         swModel.ClearSelection2 True

                       

                           '-------------------------------------WE SHOULD DELETE MATE AND TRANSLATE COMPONENT VERT--------------------------------'

                             

                       

                             

                           Set swApp = Application.SldWorks

                          Set swModel = swApp.ActiveDoc

                          Set swModelDocExt = swModel.Extension

                      boolstatus = swModelDocExt.SelectByID2("COINCIDENCE31", "MATE", 0, 0, 0, False, 0, Nothing, 0)

                          swModel.EditDelete

                        

                      '---------------------------------------------------------------------------------------------------------------------'

                      ElseIf (IsEmpty(vIntCompArray) = True) And (IsEmpty(vIntFaceArray) = True) Then

                      Debug.Print "  No contact"

                              MsgBox ("IL N'YA PAS D'INTERFERENCE ENTRE LES DEUX PIECES")

                              swModel.ClearSelection2 True

                      '----------------------------------------------------------------------------------------------------------------------------'

                          vOpenDocs = swApp.GetDocuments

                          For L = 0 To UBound(vOpenDocs)

                              Set swModel = vOpenDocs(L)

                              If swModel.GetType <> swDocDRAWING Then swApp.CloseDoc swModel.GetTitle

                          Next L

                        '------------------------------------------------------------------------------------------------------------------------------

                      Debug.Print "Current working directory is " & swApp.GetCurrentWorkingDirectory

                          Set doc = swApp.OpenDoc6("G:\ARTICLE\MODEL 1\P ROUGE.SLDPRT", swDocPART, swOpenDocOptions_Silent, "", fileerror, filewarning)

                          ' Opening a document with SldWorks::OpenDoc6 does not set the working directory

                          Debug.Print "Current working directory is still " & swApp.GetCurrentWorkingDirectory

                          ' Set the working directory to the document directory

                          swApp.SetCurrentWorkingDirectory (Left(doc.GetPathName, InStrRev(doc.GetPathName, "\")))

                          Debug.Print "Current working directory is now " & swApp.GetCurrentWorkingDirectory

                      Set swApp = Application.SldWorks

                       

                          Set swModel = swApp.ActiveDoc

                          Set swModelDocExt = swModel.Extension

                      boolstatus = swModelDocExt.SelectByID2("POINTSKETCH@P ROUGE-1@Assemblage2radif", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

                      swModel.EditDelete

                      boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)

                        

                          ' Errors

                          Debug.Print ("Errors as defined in swFileSaveError_e: " & lErrors)

                        

                       

                       

                          ' Warnings

                          Debug.Print ("Warnings as defined in swFileSaveWarning_e: " & lWarnings)

                         

                          vOpenDocs = swApp.GetDocuments

                          For L = 0 To UBound(vOpenDocs)

                              Set swModel = vOpenDocs(L)

                              If swModel.GetType <> swDocDRAWING Then swApp.CloseDoc swModel.GetTitle

                          Next L

                          Exit Sub

                       

                       

                      '--------------------------------------------------------------------------------------------------------------------'

                       

                       

                      End If

                       

                       

                      End If

                       

                       

                      Next

                         

                      End Sub

                       

                       

                      Sub TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long)

                      Dim LO As Integer

                        Dim sPadStr                     As String

                        Dim swSubSubFeat                As SldWorks.Feature

                        Dim swSubFeat                   As SldWorks.Feature

                          Dim swSubSubSubFeat             As SldWorks.Feature

                      For LO = 0 To nLevel

                              sPadStr = sPadStr + "  "

                          Next LO

                          While Not swFeat Is Nothing

                              Debug.Print sPadStr + swFeat.name + " [" + swFeat.GetTypeName + "]"

                          

                              Set swSubFeat = swFeat.GetFirstSubFeature

                                 If swFeat.GetTypeName = "PlanarSurface" Then

                      swFeat.Select True

                      End If

                              While Not swSubFeat Is Nothing

                                  Debug.Print sPadStr + "  " + swSubFeat.name + " [" + swSubFeat.GetTypeName + "]"

                                  Set swSubSubFeat = swSubFeat.GetFirstSubFeature

                                  While Not swSubSubFeat Is Nothing

                                      Debug.Print sPadStr + "    " + swSubSubFeat.name + " [" + swSubSubFeat.GetTypeName + "]"

                                      Set swSubSubSubFeat = swSubSubFeat.GetFirstSubFeature

                                      While Not swSubSubSubFeat Is Nothing

                                          Debug.Print sPadStr + "      " + swSubSubSubFeat.name + " [" + swSubSubSubFeat.GetTypeName + "]"

                                          Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()

                                      Wend

                                      Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()

                                  Wend

                                  Set swSubFeat = swSubFeat.GetNextSubFeature()

                              Wend

                              Set swFeat = swFeat.GetNextFeature

                       

                       

                        Wend

                        End Sub

                      Sub TraverseComponentFeatures(swComp As SldWorks.Component2, nLevel As Long)

                       

                          Set swFeat = swComp.FirstFeature

                          TraverseFeatureFeatures swFeat, nLevel

                      End Sub

                      Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

                          Dim LO As Long

                          Dim vChildComp                  As Variant

                          Dim swChildComp                 As SldWorks.Component2

                          Dim sPadStr                     As String

                       

                         

                          For LO = 0 To nLevel - 1

                              sPadStr = sPadStr + "  "

                          Next LO

                          vChildComp = swComp.GetChildren

                          For LO = 0 To UBound(vChildComp)

                              Set swChildComp = vChildComp(LO)

                              Debug.Print sPadStr & "+" & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"

                              TraverseComponentFeatures swChildComp, nLevel

                              TraverseComponent swChildComp, nLevel + 1

                       

                       

                          Next LO

                       

                       

                      End Sub

                      Sub TraverseModelFeatures(swModel As SldWorks.ModelDoc2, nLevel As Long)

                       

                          Set swFeat = swModel.FirstFeature

                          TraverseFeatureFeatures swFeat, nLevel

                       

                       

                      End Sub

                • Re: CHECK INTERFERENCE BETWEEN TWO FACES
                  Korbi Anis

                  Hi friends ; I used this macro to traverse the tree manager and select " planarsurface " or " 3Dprofilefeature" if exist !

                  the problem that when I run the macro it select " palanarsurface" onlu not twice !! whats the problem ? .thanks

                  this is my macro :

                   

                   

                  '=======================================================================================

                  Sub deletesurfaceSKETCH()

                  Dim swApp                       As SldWorks.SldWorks

                      Dim swModel                     As SldWorks.ModelDoc2

                      Dim swConfMgr                   As SldWorks.ConfigurationManager

                      Dim swConf                      As SldWorks.Configuration

                      Dim swRootComp                  As SldWorks.Component2

                      Dim StartTime                   As Double

                      Dim FinishTime                  As Double

                      Dim TotalTime                   As Double

                       Dim sPadStr                     As String

                           Dim swSubFeat                   As SldWorks.Feature

                      Dim swSubSubFeat                As SldWorks.Feature

                      Dim swSubSubSubFeat             As SldWorks.Feature

                      

                      

                      

                      

                      

                      Set swApp = CreateObject("SldWorks.Application")

                      Set swModel = swApp.ActiveDoc

                      Set swConfMgr = swModel.ConfigurationManager

                      Set swConf = swConfMgr.ActiveConfiguration

                      Set swRootComp = swConf.GetRootComponent3(True)

                      StartTime = Timer ' Start time

                      Debug.Print "File = " & swModel.GetPathName

                      TraverseModelFeatures swModel, 1

                      If swModel.GetType = SwConst.swDocASSEMBLY Then

                          TraverseComponent swRootComp, 1

                   

                   

                      End If

                      FinishTime = Timer ' End time

                      TotalTime = FinishTime - StartTime ' Elapsed time

                      Debug.Print ("Time = " & TotalTime & " sec")

                     

                      swModel.EditDelete

                      swModel.ClearSelection2 True

                     

                      '================================================= SELECT SKETCH3D ==============================================================

                   

                  End Sub

                  Sub TraverseFeatureFeatures(swFeat As SldWorks.Feature, nLevel As Long)

                      Dim swSubFeat                   As SldWorks.Feature

                      Dim swSubSubFeat                As SldWorks.Feature

                      Dim swSubSubSubFeat             As SldWorks.Feature

                   

                   

                     

                      Dim sPadStr                     As String

                      Dim i                           As Long

                      For i = 0 To nLevel

                          sPadStr = sPadStr + "  "

                      Next i

                      While Not swFeat Is Nothing

                          Debug.Print sPadStr + swFeat.name + " [" + swFeat.GetTypeName + "]"

                      

                          Set swSubFeat = swFeat.GetFirstSubFeature

                             If swFeat.GetTypeName = "PlanarSurface" Then

                  swFeat.Select True

                   

                   

                  End If

                        

                          While Not swSubFeat Is Nothing

                              Debug.Print sPadStr + "  " + swSubFeat.name + " [" + swSubFeat.GetTypeName + "]"

                              Set swSubSubFeat = swSubFeat.GetFirstSubFeature

                               If swSubSubFeat.GetTypeName = "3DProfileFeature" Then

                  swSubFeat.Select True

                   

                   

                  End If

                       While Not swSubSubFeat Is Nothing

                                  Debug.Print sPadStr + "    " + swSubSubFeat.name + " [" + swSubSubFeat.GetTypeName + "]"

                                  Set swSubSubSubFeat = swSubSubFeat.GetFirstSubFeature

                             

                                  While Not swSubSubSubFeat Is Nothing

                                      Debug.Print sPadStr + "      " + swSubSubSubFeat.name + " [" + swSubSubSubFeat.GetTypeName + "]"

                                      Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()

                                  Wend

                                  Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()

                              Wend

                              Set swSubFeat = swSubFeat.GetNextSubFeature()

                          Wend

                          Set swFeat = swFeat.GetNextFeature

                   

                   

                    Wend

                   

                   

                  End Sub

                  ============================================================================================

                  Sub TraverseComponentFeatures(swComp As SldWorks.Component2, nLevel As Long)

                      Dim swFeat As SldWorks.Feature

                      Set swFeat = swComp.FirstFeature

                      TraverseFeatureFeatures swFeat, nLevel

                  End Sub

                  ===========================================================================================

                  Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

                      Dim vChildComp                  As Variant

                      Dim swChildComp                 As SldWorks.Component2

                      Dim sPadStr                     As String

                      Dim i                           As Long

                     

                      For i = 0 To nLevel - 1

                          sPadStr = sPadStr + "  "

                      Next i

                      vChildComp = swComp.GetChildren

                      For i = 0 To UBound(vChildComp)

                          Set swChildComp = vChildComp(i)

                          Debug.Print sPadStr & "+" & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"

                          TraverseComponentFeatures swChildComp, nLevel

                          TraverseComponent swChildComp, nLevel + 1

                   

                   

                      Next i

                   

                   

                  End Sub

                  ====================================================================================

                  Sub TraverseModelFeatures(swModel As SldWorks.ModelDoc2, nLevel As Long)

                      Dim swFeat As SldWorks.Feature

                      Set swFeat = swModel.FirstFeature

                      TraverseFeatureFeatures swFeat, nLevel

                   

                   

                  End Sub