AnsweredAssumed Answered

Update reference entities for plane definition via API

Question asked by Ryan Doving on Sep 18, 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: 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

Attachments

Outcomes