0 Replies Latest reply on Sep 18, 2018 5:23 PM by Ryan Doving

    Update reference entities for plane definition via API

    Ryan Doving

      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: Change reference entities for RefPlane (API)

       

      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