AnsweredAssumed Answered

Macro to add reference point to selected faces, crashes? Please help.

Question asked by Derek Eldridge on Dec 3, 2018
Latest reply on Dec 6, 2018 by Derek Eldridge

I'm trying to learn more about the selection tool in the API as well as create a macro to add a ref point to the center of all 12 selected faces.

I get as far as addressing the selected faces, and then when I try to add the reference point, SW crashes.

Can someone tell me what I'm doing wrong?



I select the following faces:

Option Explicit

Sub main()

' 1 radian = 180º/p = 57.295779513º or approximately 57.3º

Const RadPerDeg As Double = 1# / 57.3

Const MaxUAngle As Double = 1# * RadPerDeg

Const MaxVAngle As Double = 1# * RadPerDeg

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.modelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swBody As SldWorks.Body2

Dim swProcBody As SldWorks.Body2

Dim swPart As SldWorks.PartDoc

Dim swNewPart As SldWorks.PartDoc

Dim swFeat As SldWorks.Feature

Dim vBodies As Variant

Dim errors As Long

Dim warnings As Long

Dim fileName As String

Dim status As Boolean

Dim swBodyVar As Variant

Dim swSelFaceVar As Variant

Dim swSelFaceCount As Long

Dim selectedFace As SldWorks.Component2

Dim selectedFaces() As Object

Dim selectionMgr As SldWorks.selectionMgr

Dim selObj As Object

Dim count As Long

Dim i As Long

Dim modelDoc2 As SldWorks.modelDoc2


Dim featMgr As SldWorks.FeatureManager

Dim NRefPointType As Integer

Dim NRefPointAlongCurveType As Integer

Dim DDistance_or_Percent As Double

Dim NumberOfRefPoints As Integer

Dim addpoint As Feature

Dim instance As swRefPointType_e


Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swPart = swModel

Set featMgr = swModel.FeatureManager


'Get and process body in part

vBodies = swPart.GetBodies2(swSolidBody, False)

Set swBody = vBodies(0)

Set swProcBody = swBody.GetProcessedBody2(MaxUAngle, MaxVAngle)


'Select multiple faces in new part

'Set swModel = swNewPart

Debug.Print "New part title: " & swModel.GetTitle

Debug.Print " Body faces: " & swBody.GetFaceCount

Debug.Print " Processed body faces: " & swProcBody.GetFaceCount

Set swModelDocExt = swModel.Extension

Set selectionMgr = swModel.SelectionManager


'Selects extra face

'status = swModelDocExt.SelectByID2("", "FACE", 0, 0, 0, True, 0, Nothing, 0)

Set selObj = selectionMgr.GetSelectedObject6(1, -1)


'deselects extra face

'status = swModelDocExt.SelectByID2("", "FACE", 0, 0, 0, True, 0, Nothing, 0)

Set selObj = selectionMgr.GetSelectedObject6(2, -1)


count = selectionMgr.GetSelectedObjectCount2(0)


'Assign Selected faces to variables in array.

ReDim selectedFaces(count - 1)


For i = 0 To count - 1

Set selectedFace = selectionMgr.GetSelectedObjectsFace(i + 1, 0)

Set selectedFaces(i) = selectedFace


'attempt to Insert reference points on selected faces while addressing faces

addpoint = featMgr.InsertReferencePoint(swRefPointFaceCenter, 2, 0, count)



'attempt to Insert reference points on selected faces in a separate for statment.

'For i = 0 To UBound(selectedFaces)

'Note: swRefPointFaceCenter = 4

'addpoint = featMgr.InsertReferencePoint(4, 2, 0, count)

'Next i



End Sub