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
SolidworksApi macros