Inserts an axis perpendicular to the centre of a plane face

Good morning to all.

I would like to create a macro in vba that inserts an axis perpendicular to the centre of a plane face.

I was able to find the code that finds the centre of the face and the perpendicular but I cannot create the axis.

Can anyone help me?

Thanks in advance.

Fabrizio

I attach the code below.

'**********************
'Copyright(C) 2025 Xarial Pty Limited
'Reference: Get parameters of face at centroid using SOLIDWORKS API
'License: License
'**********************

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeatMgr As SldWorks.FeatureManager
Dim swFace As SldWorks.Face2
Dim centerPoint(2) As Double
Dim normalVec(2) As Double
Dim boolstatus As Boolean
Dim swAxisFeature As SldWorks.Feature
Dim swRefAxis As SldWorks.RefAxis

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swFeatureMgr = swModel.FeatureManager

If Not swModel Is Nothing Then
    
    Dim swFace As SldWorks.Face2
    Set swFace = swModel.SelectionManager.GetSelectedObject6(1, -1)
    
    If Not swFace Is Nothing Then
        
        Dim vPt As Variant
        Dim vNorm As Variant
        
        GetFaceCenterParameters swFace, vPt, vNorm
        
        Debug.Print "Coordinate at face center is: " & vPt(0) * 1000 & ", " & vPt(1) * 1000 & ", " & vPt(2) * 1000
        Debug.Print "Normal at face center is: " & vNorm(0) & ", " & vNorm(1) & ", " & vNorm(2)
        
        ' Coordinate del punto
Dim x As Double: x = vPt(0) * 1000
Dim y As Double: y = vPt(1) * 1000
Dim z As Double: z = vPt(2) * 1000
        ' Vettore normale (direzione dell'asse)
Dim nx As Double: nx = vNorm(0)
Dim ny As Double: ny = vNorm(1)
Dim nz As Double: nz = vNorm(2)

        ' Crea un asse usando punto e direzione
Set swAxisFeature = swFeatMgr.InsertAxis2(x, y, z, nx, ny, nz)
    
        'Fine disegna Asse
    
    Else
        MsgBox "Please select face"
    End If
    
Else
    MsgBox "Please open the model"
End If

End Sub

Sub GetFaceCenterParameters(face As SldWorks.Face2, ByRef point As Variant, ByRef normal As Variant)

Dim vUvBounds As Variant
vUvBounds = face.GetUVBounds

Dim centerU As Double
Dim centerV As Double
    
centerU = (vUvBounds(0) + vUvBounds(1)) / 2
centerV = (vUvBounds(2) + vUvBounds(3)) / 2

Dim swSurf As SldWorks.Surface
Set swSurf = face.GetSurface

Dim vEvalRes As Variant
vEvalRes = swSurf.Evaluate(centerU, centerV, 0, 0)

Dim dPoint(2) As Double
Dim dNormal(2) As Double

dPoint(0) = vEvalRes(0)
dPoint(1) = vEvalRes(1)
dPoint(2) = vEvalRes(2)

dNormal(0) = vEvalRes(3)
dNormal(1) = vEvalRes(4)
dNormal(2) = vEvalRes(5)

point = dPoint
normal = dNormal

End Sub

Hi Fabrizio,
try this one - I’ve made a few updates…

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Dim swFace As face2
Dim swSurface As Surface
Dim centroid As MathPoint
Dim swMath As MathUtility

Sub main()

    Set swApp = Application.SldWorks
    Set swModelDoc = swApp.ActiveDoc
    Set swModelDocExt = swModelDoc.Extension
    Set swSelMgr = swModelDoc.SelectionManager
    Set swMath = swApp.GetMathUtility
    
    Set swFace = swSelMgr.GetSelectedObject6(1, -1)
    
    If Not swFace Is Nothing Then
        
        Set swSurface = swFace.GetSurface
        If swSurface.IsPlane Then
            Set centroid = GetCentroidOfSelctedFace(swFace)
            
            Dim sketchPoint As sketchPoint
            Set sketchPoint = CreateCentroidInSketch(centroid)
            
            Dim entity As entity
            Set entity = swFace
            sketchPoint.Select4 False, Nothing
            entity.Select4 True, Nothing
            swModelDoc.InsertAxis2 True
            
        End If

    Else
        MsgBox "Please select face"
    End If
    
swModelDoc.ForceRebuild3 True

Set swModelDoc = Nothing
Set swModelDocExt = Nothing
Set swSelMgr = Nothing
Set swFace = Nothing
Set swSurface = Nothing
Set centroid = Nothing
Set swMath = Nothing
End Sub

Private Function GetCentroidOfSelctedFace(swFace As face2) As MathPoint

    Dim face1(0 To 0) As Object
    Set face1(0) = swFace
    
    swModelDoc.ClearSelection2 True
    
    Dim vFace1 As Variant
    vFace1 = face1
    
    Dim v1 As Variant
    v1 = swModelDocExt.GetSectionProperties2((vFace1))

    Dim swCentroid As MathPoint
    Dim centroid(2) As Double
    
    centroid(0) = CDbl(v1(2))
    centroid(1) = CDbl(v1(3))
    centroid(2) = CDbl(v1(4))
    
    Set swCentroid = swMath.CreatePoint(centroid)
    Set GetCentroidOfSelctedFace = swCentroid
    
End Function

Private Function CreateCentroidInSketch(centroid As MathPoint) As sketchPoint
    Dim swSketch As Sketch
    Dim swSketchManager As SketchManager
    Dim transformedPoint As MathPoint
    
    Set swSketchManager = swModelDoc.SketchManager
    
    swSketchManager.InsertSketch False
    Set swSketch = swSketchManager.ActiveSketch
    
    Set transformedPoint = TransformPoint(centroid, swSketch)
    
    Dim sketchPoint As sketchPoint
    Set sketchPoint = swSketchManager.CreatePoint(transformedPoint.ArrayData(0), transformedPoint.ArrayData(1), transformedPoint.ArrayData(2))
    swModelDoc.SketchAddConstraints ("sgFIXED")
    swSketchManager.InsertSketch True
    Set CreateCentroidInSketch = sketchPoint
    
End Function

Private Function TransformPoint(centroid As MathPoint, swSketch As Sketch) As MathPoint

    Dim sketchTransform As MathTransform
    Set sketchTransform = swSketch.ModelToSketchTransform
    
    Set TransformPoint = centroid.MultiplyTransform(sketchTransform)

End Function

3 Likes

Thank you, Marcel,
I’ve just had the chance to test your modifications, and everything works perfectly.
I really appreciate your contribution.
I’ll be using it in SolidWorks CAM to create axes for rotating features, and I definitely recommend it to anyone with similar needs.
You’ve done an excellent job—thanks again!
Have a great day,
Fabrizio

1 Like