6 Replies Latest reply on Jun 13, 2018 2:40 AM by Manikandan Babu

    Select Referene points one by one in 3D sketch

    Korbi Anis

      Hello friends , I tried to write a macro that descritise a cylindrical face into points.I select the face , I created the sketch curve on this face and after I created a reference points on each sketch curve wich are already exist inside the 3D sketch . Can someone help me to select then the reference points one by one inside a sketch? thank you

       

      This is the macro

       

      Option Explicit

       

       

       

       

       

      Dim swApp As SldWorks.SldWorks

       

       

      Dim swModel As SldWorks.ModelDoc2

       

       

      Dim swModelDocExt As SldWorks.ModelDocExtension

       

       

      Dim swSketchManager As SldWorks.SketchManager

       

       

      Dim boolstatus As Boolean

      Public swPart As PartDoc

      Public swFeatMgr As FeatureManager

      Dim swSelMgr As SldWorks.SelectionMgr

      Dim swSelData As Object

      Dim vBodies             As Variant

      Dim swBody As SldWorks.Body2

       

       

      Dim swFace              As SldWorks.Face2

      Dim sCurFaceName As String

      Dim swEnt As SldWorks.Entity

      Dim bRet                As Boolean

      Dim lMark  As Long

      Dim swSket As SldWorks.Sketch

      Dim swFeat As SldWorks.Feature

      Dim swMeasure As SldWorks.Measure

      Dim status As Boolean

      Dim errors As Long

      Dim warnings As Long

      Dim fileName As String

       

       

      Dim swSketchArc As SketchArc

      Dim swSketchPoint As SketchPoint

      Dim radius As Double

      Dim X1 As Double

      Dim Y1 As Double

      Dim Z1 As Double

      Dim R1 As Double

      Dim R2 As Double

      Dim R3 As Double

      Dim i As Integer

      Dim swSeg As SldWorks.SketchSegment

      Dim j As Integer

      Dim somme(50) As Variant

      Dim T(0) As Variant

      Dim vRefPointFeatures As Variant

      Dim swSketch As SldWorks.Sketch

      Dim varc As Variant

      Dim swPOINT As SldWorks.Sketch

       

       

       

       

       

       

       

       

       

       

       

      Sub main()

       

       

       

       

       

      Set swApp = Application.SldWorks

       

       

      Set swModel = swApp.ActiveDoc

       

       

      Set swModelDocExt = swModel.Extension

       

       

      Set swSketchManager = swModel.SketchManager

       

       

       

      '=========================================================== SELECT FACE ==================================================================

      Set swApp = CreateObject("SldWorks.Application")

      Set swModel = swApp.ActiveDoc

      Set swPart = swModel

      Set swFeatMgr = swModel.FeatureManager

      Set swSelMgr = swModel.SelectionManager

      Set swSelData = swSelMgr.CreateSelectData

      vBodies = swPart.GetBodies2(swAllBodies, True)

      Set swBody = vBodies(0)

      Set swFace = swBody.GetFirstFace

      Do While Not swFace Is Nothing

      sCurFaceName = swModel.GetEntityName(swFace)

      If sCurFaceName Like "5" & "*" Then

      Set swEnt = swFace

      bRet = swEnt.Select4(True, swSelData)

      swEnt.SelectByMark False, 1

      lMark = lMark + 1

      End If

      Set swFace = swFace.GetNextFace

      Loop

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

       

       

      swSketchManager.Insert3DSketch True

      Set swSket = swModel.GetActiveSketch2

       

       

          Set swFeat = swSket

      swFeat.Name = "SKET1"

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

      ' Convert edges of faces to sketch entities

       

       

      boolstatus = swSketchManager.SketchUseEdge2(False)

       

       

       

       

      ' Clear the selections and close the sketch

       

       

      swModel.ClearSelection2 True

       

       

      swSketchManager.Insert3DSketch True

       

       

      swModel.ClearSelection2 True

      '======================================================Measure diameter and center of the previous sketch 3D circle=====================================================================

      boolstatus = swModelDocExt.SelectByID2("Arc4@SKET1", "EXTSKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)

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

      Set swSketchPoint = swSketchArc.GetCenterPoint2

      radius = swSketchArc.GetRadius

      X1 = (swSketchPoint.X)

      Y1 = (swSketchPoint.Y)

      Z1 = (swSketchPoint.Z)

      Debug.Print "X1 = " & (swSketchPoint.X) * 1000

      Debug.Print "Y1 = " & (swSketchPoint.Y) * 1000

      Debug.Print "Z1 = " & (swSketchPoint.Z) * 1000

      Debug.Print "R1 = " & radius * 1000

      swModel.ClearSelection2 True

         

      '================================================================== INSERT NEW SKETCH ARC =====================================================================

          swSketchManager.Insert3DSketch True

      Set swSket = swModel.GetActiveSketch2

       

       

          Set swFeat = swSket

      swFeat.Name = "SKET2"

       

      ' Clear the selections and close the sketch

       

       

      swModel.ClearSelection2 True

       

       

       

       

      swModel.ClearSelection2 True

       

      '==================================================================== CREATE CIRCLE  WITH INCREMENT MESURE DISTANCE BETWEEN R1 AND R2 =======================

       

          Set swSketchManager = swModel.SketchManager

          R1 = radius * 1000

         

       

      For i = 0 To 4

         T(0) = 5

       

       

      somme(0) = 0

      somme(1) = 1 * T(0)

      somme(2) = 2 * T(0)

      somme(3) = 3 * T(0)

      somme(4) = 4 * T(0)

      somme(5) = 5 * T(0)

      somme(6) = 6 * T(0)

      somme(7) = 7 * T(0)

      somme(8) = 8 * T(0)

      somme(9) = 9 * T(0)

      somme(10) = 10 * T(0)

      somme(11) = 11 * T(0)

      somme(12) = 12 * T(0)

      somme(13) = 13 * T(0)

      somme(14) = 14 * T(0)

      somme(15) = 15 * T(0)

       

       

       

       

      R2 = R1 - somme(i)

          ' Sketch a circle

      If R2 > 0 Then

          Set swSeg = swSketchManager.CreateCircleByRadius(X1, Y1, Z1, R2 / 1000)

       

       

      '==================================================== DESCRITISE SKETCH SEGMENT ==============================================================

       

       

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

      swModel.ClearSelection2 True

      End If

       

          Next

            swSketchManager.Insert3DSketch True

            swModel.ClearSelection2 True

           

           

           

           

           

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

       

       

         Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          Set swModelDocExt = swModel.Extension

          Set swSelMgr = swModel.SelectionManager

          boolstatus = swModelDocExt.SelectByID2("SKET2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

           boolstatus = swModelDocExt.SelectByID2("SKET1", "SKETCH", 0, 0, 0, True, 0, Nothing, 1)

        Set swFeat = swSelMgr.GetSelectedObject5(1)

          swModel.ClearSelection2 True

      Set swSketch = swFeat.GetSpecificFeature2

       

       

             

       

       

              Dim vSketchSegs As Variant

             

       

       

              Dim swSketchSeg As SketchSegment

       

       

       

       

              vSketchSegs = swSketch.GetSketchSegments

       

       

              swModel.ClearSelection2 (True)

       

       

              For i = 0 To UBound(vSketchSegs)

       

       

                 Set swSketchSeg = vSketchSegs(i)

       

       

                  If swSketchSeg.GetType = swSketchSegments_e.swSketchArc Then

       

       

                      swSketchSeg.Select4 True, Nothing

                     

      vRefPointFeatures = swFeatMgr.InsertReferencePoint(2, 2, 0, 12)

      swModel.ClearSelection2 True

       

       

                  End If

       

       

              Next

       

       

      swModel.ClearSelection2 True

       

       

       

       

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

       

       

      Stop

       

      '==================================== In this section I need to select the reference points ONE BY ONE !!!! ==============================

      ?????

      ????

       

           

           

           

           

           

      End Sub

        • Re: Select Referene points one by one in 3D sketch
          Manikandan Babu

          Hi Korbi,

           

          Can you share the sample model to work out

           

          Thanks

          Manikandan

            • Re: Select Referene points one by one in 3D sketch
              Korbi Anis

              Hello dear Friend , you can use any culindrical part and name any face by "5".

                • Re: Select Referene points one by one in 3D sketch
                  Manikandan Babu

                  Hi Korbi,

                  Please refer the below code.

                   

                  Dim swApp As SldWorks.SldWorks

                  Dim swmodel As SldWorks.ModelDoc2

                  Dim swselmgr As SldWorks.SelectionMgr

                  Dim swfeat As SldWorks.Feature

                  Dim swrefpoint As SldWorks.RefPoint

                  Dim count As Integer

                  Dim swMathPt                    As SldWorks.MathPoint

                  Dim i As Integer

                  Dim j As Integer

                  Dim vobject() As SldWorks.Feature

                  Sub main()

                  Set swApp = Application.SldWorks

                  Set swmodel = swApp.ActiveDoc

                  Set swfeat = swmodel.FirstFeature

                   

                   

                  While Not swfeat Is Nothing

                  If swfeat.GetTypeName = "RefPoint" Then

                  swfeat.Select True

                  End If

                  Set swfeat = swfeat.GetNextFeature

                  Wend

                  count = swmodel.SelectionManager.GetSelectedObjectCount

                   

                  ReDim Preserve vobject(1 To count)

                  For i = 1 To count

                  Set vobject(i) = swmodel.SelectionManager.GetSelectedObject6(i, -1)

                  Next

                  swmodel.ClearSelection2 True

                   

                  swmodel.SketchManager.Insert3DSketch True

                   

                  For j = 1 To UBound(vobject)

                  Set swfeat = vobject(j)

                  Set swrefpoint = swfeat.GetSpecificFeature2

                  Set swMathPt = swrefpoint.GetRefPoint

                  boolstatus = swmodel.Extension.SelectByID2("", "DATUMPOINT", swMathPt.ArrayData(0), swMathPt.ArrayData(1), swMathPt.ArrayData(2), True, 0, Nothing, 0)

                  Next

                  End Sub

                    • Re: Select Referene points one by one in 3D sketch
                      Korbi Anis

                      Thnak you very much for your support my friend

                      • Re: Select Referene points one by one in 3D sketch
                        Korbi Anis

                        I tried this macro , however , if there are many reference points or datum points in the Features Manager Tree , how can I just select these points not others ?? Thank you

                          • Re: Select Referene points one by one in 3D sketch
                            Manikandan Babu

                            Hi Korbis,

                            Please try this..

                            Dim swApp As SldWorks.SldWorks

                            Dim swmodel As SldWorks.ModelDoc2

                            Dim swselmgr As SldWorks.SelectionMgr

                            Dim swfeat As SldWorks.Feature

                            Dim swrefpoint As SldWorks.RefPoint

                            Dim count As Integer

                            Dim swMathPt                    As SldWorks.MathPoint

                            Dim i As Integer

                            Dim j As Integer

                            Dim vobject() As SldWorks.Feature

                            Sub main()

                            Set swApp = Application.SldWorks

                            Set swmodel = swApp.ActiveDoc

                            Set swfeat = swmodel.FirstFeature

                             

                            'Instead of feature count give your created reference point count

                            'featCount = swmodel.GetFeatureCount

                            featCount =ubound(vSketchSegs)*12

                                For i = featCount To 1 Step -1

                                    Set swfeat = swmodel.FeatureByPositionReverse(featCount - i)

                                    If Not swfeat Is Nothing Then

                                    If swfeat.GetTypeName = "RefPoint" Then

                                       swfeat.Select True

                                       Else

                                       Exit For

                                       End If

                                    End If

                                Next

                             

                            count = swmodel.SelectionManager.GetSelectedObjectCount

                             

                            ReDim Preserve vobject(1 To count)

                            For i = 1 To count

                            Set vobject(i) = swmodel.SelectionManager.GetSelectedObject6(i, -1)

                            Next

                            swmodel.ClearSelection2 True

                             

                            swmodel.SketchManager.Insert3DSketch True

                             

                            For j = 1 To UBound(vobject)

                            Set swfeat = vobject(j)

                            Set swrefpoint = swfeat.GetSpecificFeature2

                            Set swMathPt = swrefpoint.GetRefPoint

                            boolstatus = swmodel.Extension.SelectByID2("", "DATUMPOINT", swMathPt.ArrayData(0), swMathPt.ArrayData(1), swMathPt.ArrayData(2), True, 0, Nothing, 0)

                            Next

                            End Sub