AnsweredAssumed Answered

Select Referene points one by one in 3D sketch

Question asked by Korbi Anis on Jun 10, 2018
Latest reply on Jun 13, 2018 by Manikandan Babu

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

Outcomes