I am writing a VBA macro to update the entity for a reference plane. The workflow should be:
1. Select the plane to redefine
2. Select the new reference geometry (either face or plane)
3. Run macro. Macro will update the reference plane to be coincident with the new reference geometry.
It is important that the normal vector remain the same after updating the plane's definition.
I am able to successfully run my macro within a part, but it doesn't work when I try to define a part's plane to be coincident with a reference plane in an assembly. See below for my macro. I have also attached a sample assembly and part.
Much of this is based on the code found in the thread at:
Option Explicit
Dim swApp As Object
Sub main()
Set swApp = Application.SldWorks
Dim ppmPlane As SldWorks.Feature
Dim refGeo As SldWorks.Entity
Dim bStatus As Boolean
VerifySelections
Set ppmPlane = ParseFirstSelection()
Set refGeo = ParseSecondSelection()
Debug.Print "PPM plane to modify = " + ppmPlane.Name
Debug.Print "New reference geometry type = " + CStr(refGeo.GetType)
bStatus = UpdatePlaneRef(ppmPlane, refGeo)
End Sub
Sub VerifySelections()
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim iSelCount As Integer
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
iSelCount = swSelMgr.GetSelectedObjectCount2(-1)
Debug.Print "Number of selections: " + CStr(iSelCount)
'make sure there are exactly 2 selections
If iSelCount <> 2 Then
MsgBox "Please select a plane first, then reference geometry, and re-run the macro."
End
End If
End Sub
Function ParseFirstSelection() As SldWorks.Feature
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim iSelCount As Integer
Dim swFeat As SldWorks.Feature
Dim swEnt As SldWorks.Entity
Dim featName As String
Dim msgBoxAnswer As Integer
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
'faces aren't features, so we have to use an entity to check selection type
Set swEnt = swSelMgr.GetSelectedObject6(1, 0)
If swEnt Is Nothing Then
MsgBox "Please select a plane first, then reference geometry, and re-run the macro."
End
End If
'make sure the first selection is a plane before proceeding as a feature
If swEnt.GetType <> swSelDATUMPLANES Then
MsgBox "Please select a plane first, then reference geometry, and re-run the macro."
End
End If
Set swEnt = Nothing
Set swFeat = swSelMgr.GetSelectedObject6(1, 0)
featName = swFeat.Name
Debug.Print "First selection: " + featName
'save this as our PPM plane to edit
Set ParseFirstSelection = swFeat
End Function
Function ParseSecondSelection() As SldWorks.Entity
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swEnt As SldWorks.Entity
Dim refGeoType As Integer
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
'we don't know what is selected, and entity is safer in case it isn't a plane
Set swEnt = swSelMgr.GetSelectedObject6(2, 0)
'make sure there is a selection
If swEnt Is Nothing Then
MsgBox "Please select a plane first, then reference geometry, and re-run the macro."
End
End If
'make sure reference geometry is face, vertex or plane
refGeoType = swEnt.GetType
If refGeoType <> swSelFACES And _
refGeoType <> swSelDATUMPLANES And _
refGeoType <> swSelVERTICES Then
MsgBox "Your reference geometry is not of a supported type (" + CStr(refGeoType) + ")"
End
End If
Set ParseSecondSelection = swEnt
End Function
Function UpdatePlaneRef(swPlane As SldWorks.Feature, swRefGeo As SldWorks.Entity) As Boolean
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swEntity As SldWorks.Entity
Dim swParentModel As SldWorks.ModelDoc2
Dim swParentComponent As SldWorks.Component2
Dim swPlaneData As IRefPlaneFeatureData
Dim bStatus As Boolean
Dim vReference As Variant
Dim i As Integer
Dim lInfo As Long
'clear selections
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 (True)
'cast PPM plane to entity to get parent component
'edit the part if it is contained in an assembly
'if this is a part then we are already editing it
If swModel.GetType = swDocASSEMBLY Then
Set swEntity = swPlane
Set swParentComponent = swEntity.GetComponent
Set swParentModel = swParentComponent.GetModelDoc2
Debug.Print "PPM plane's parent component = " + swParentComponent.Name2
Else
Set swParentModel = swApp.ActiveDoc
End If
'get info for PPM plane
Set swPlaneData = swPlane.GetDefinition
bStatus = swPlaneData.AccessSelections(swParentModel, Nothing)
'update PPM plane references
Set vReference = swPlaneData.Reference(0)
If Not vReference Is Nothing Then
'update PPM plane's reference to new geometry
swPlaneData.Reference(0) = swRefGeo
'make sure plane's constraint is coincident
swPlaneData.Constraint(0) = swRefPlaneReferenceConstraint_Coincident
End If
bStatus = swPlane.ModifyDefinition(swPlaneData, swParentModel, Nothing)
End Function