CAD Forum

Hello,

I am working on a macro to extrude cut a text sketch and I need to insert that sketch at the center of the selected face.

I used bounding box to get the center of the face but this method does not work for some faces (sketch is not on the face but very far away from it) so I am looking for the simplest way to insert the sketch text directly at the center of the face. Here is the code :

Sub ApplyEngravingMacro(swModel As SldWorks.ModelDoc2, swFace As SldWorks.Face2)
Dim swSketchMgr As SldWorks.SketchManager
Dim boolstatus As Boolean
Dim selPt As Variant
Dim modView As ModelView
Dim strEngrave As String
Dim swFeatMgr As SldWorks.FeatureManager
Dim swCut As SldWorks.Feature

strEngrave = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
strEngrave = Left(strEngrave, InStrRev(strEngrave, ".") - 1)

Set modView = swModel.ActiveView
modView.EnableGraphicsUpdate = False
swModel.FeatureManager.EnableFeatureTree = False

' Get bounding box center for a reliable point on the face
Dim bbox As Variant
bbox = swFace.GetBox
selPt = Array((bbox(0) + bbox(3)) / 2, (bbox(1) + bbox(4)) / 2, (bbox(2) + bbox(5)) / 2)

' Use SelectByRay to select the face precisely
boolstatus = swModel.Extension.SelectByRay(selPt(0), selPt(1), selPt(2), 0, 0, 1, 0.001, 2, False, 0, 0)

' Begin a sketch on the face
Set swSketchMgr = swModel.SketchManager
swSketchMgr.InsertSketch True ' Start the sketch on the selected face

If Not swModel.SketchManager.ActiveSketch Is Nothing Then
' Create a construction line on the sketch plane for text alignment
Dim skLine As SldWorks.SketchLine
Set skLine = swModel.CreateLine2(selPt(0), selPt(1), selPt(2), selPt(0) + ConvertToMeters(2), selPt(1), selPt(2))
skLine.ConstructionGeometry = True
swModel.SketchAddConstraints SketchCon

' Insert text at the calculated center point on the face
Dim skText As SldWorks.SketchText
Set skText = swModel.InsertSketchText(selPt(0), selPt(1), selPt(2), strEngrave, 0, FlipText, MirrorText, 100, 100)

'---set text height------------------------------------------
Set swTextFormat = skText.GetTextFormat
swTextFormat.CharHeight = ConvertToMeters(TextH)
boolstatus = skText.SetTextFormat(False, swTextFormat)
swModel.SketchManager.AddToDB = False

' Create an extrude cut for engraving
Set swFeatMgr = swModel.FeatureManager
Set swCut = swFeatMgr.FeatureCut4(True, False, False, 0, 0, 0.002, 0.002, False, False, False, False, _
1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, _
False, True, True, True, True, False, 0, 0, True, False)
If Not swCut Is Nothing Then
swCut.Name = strEngrave & " Engraving"
Else
MsgBox "Failed to create extrude cut on " & strEngrave
End If
Else
MsgBox "Sketch was not created on the selected face. Please ensure face selection is correct."
End If

modView.EnableGraphicsUpdate = True
swModel.FeatureManager.EnableFeatureTree = True
End Sub