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