ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
RDRyan Doving18/09/2018

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