AnsweredAssumed Answered

Change reference entities for RefPlane (API)

Question asked by Erik Söderby on Mar 9, 2016
Latest reply on Mar 10, 2016 by Erik Söderby

Hi! I want to replace the reference entities for a RefPlane(Plane1), from Axis1 and Point1 to Axis2 and Point2. I get no errors, but nothing happens. Note that this works if the entities happen to be splines or other sketch segments, but not when I'm working with reference points/axises as entities. Does anyone have an idea?

 

Dim swApp As Object

Dim Part As Object

Dim boolstatus As Boolean

Dim swSelMgr As SldWorks.SelectionMgr

Dim ReplacementEntity1 As SldWorks.Feature

Dim ReplacementEntity2 As SldWorks.Feature

Dim FeatureToAdjust As SldWorks.Feature

Dim swRefPlane As SldWorks.RefPlane

Dim swRefPlaneData As IRefPlaneFeatureData

Dim FeatMgr As SldWorks.FeatureManager

Dim SelArr As Variant

Dim Selection As Variant

 

Sub main()

 

Set swApp = _

Application.SldWorks

Set Part = swApp.ActiveDoc

Set swSelMgr = Part.SelectionManager

Set FeatMgr = Part.FeatureManager

 

'***Setting the two replacement entities:

boolstatus = Part.Extension.SelectByID2("Axis2", "AXIS", 0, 0, 0, True, 0, Nothing, 0)

Set ReplacementEntity1 = swSelMgr.GetSelectedObject6(1, -1)

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Point2", "DATUMPOINT", 0, 0, 0, True, 0, Nothing, 0)

Set ReplacementEntity2 = swSelMgr.GetSelectedObject6(1, -1)

Part.ClearSelection2 True

 

'**The plane I want to change reference entities for:

boolstatus = Part.Extension.SelectByID2("Plane1", "PLANE", 0, 0, 0, True, 0, Nothing, 0

Set FeatureToAdjust = swSelMgr.GetSelectedObject6(1, -1)

Set swRefPlaneData = FeatureToAdjust.GetDefinition

boolstatus = swRefPlaneData.AccessSelections(Part, Nothing)

 

'**Set new reference entities for the RefPlane

SelArr = swRefPlaneData.Selections

For I = 0 To UBound(SelArr)

Set Selection = SelArr(I)

If Selection.GetTypeName2 = "RefAxis" Then

Set SelArr(I) = ReplacementEntity1

ElseIf Selection.GetTypeName2 = "RefPoint" Then

Set SelArr(I) = ReplacementEntity2

End If

Next I

 

swRefPlaneData.Selections = SelArr

boolstatus = FeatureToAdjust.ModifyDefinition(swRefPlaneData, Part, Nothing)

swRefPlaneData.ReleaseSelectionAccess

Part.EditRebuild3

Outcomes