VBA - Assigning a variable a manual selection

ixxs71 · September 24, 2021, 10:19am

Hello

From a selection such as this code

Dim swEnt As SldWorks.Face2
Set swEnt = Part.SelectionManager.GetSelectedObject6(1, 0)
Do While swEnt Is Nothing
    DoEvents
    Set swEnt = Part.SelectionManager.GetSelectedObject6(1, 0)
Loop

I want to perform a first operation and rather than making a selection again to point to the same face, is it possible to place the result of the pointing in a variable? And how do you call this selection to perform the new operation?

I hope I have been clear enough...

d.roger · September 24, 2021, 11:33am

Hello

"Is it possible to place the result of the pointing in a variable?": this is already what you are doing since you store your selection in the swEnt variable, so as long as your macro is running, you don't reset this variable or assign it a new value ...

Kind regards

ixxs71 · September 24, 2021, 12:53pm

Yep, I'm ok with the principle, but how do I point to this variable afterwards? (see comment at the end of the code)


 

'*****************************************************
'Axe extrusion
'*****************************************************

Dim swEnt As SldWorks.Face2
Set swEnt = Part.SelectionManager.GetSelectedObject6(1, 0)
Do While swEnt Is Nothing
    DoEvents
    Set swEnt = Part.SelectionManager.GetSelectedObject6(1, 0)
Loop

boolstatus = Part.InsertAxis2(True)

'*****************************************************
'Plan 2 axes
'*****************************************************

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

Dim myRefPlane As Object
Set myRefPlane = Part.FeatureManager.InsertRefPlane(4, 0, 4, 0, 0, 0)

'*****************************************************
'Plan perpenticulaire et tangent
'*****************************************************

'Comment je récupère la valeur de swEnt pour réaliser mon plan tangent à swEnt et perpendiculaire au plan créer juste au dessus ?

Set myRefPlane = Part.FeatureManager.InsertRefPlane(2, 0, 32, 0, 0, 0)

Maclane · September 24, 2021, 1:38pm

Hello;

One clue = https://help.solidworks.com/SOLIDWORKS.Interop.sldworks~SOLIDWORKS.Interop.sldworks.IFeatureManager~InsertRefPlane.html
with

. InsertRefPlane(FirstConstraint, FirstConstraintAngleOrDistance_
, SecondConstraint, SecondConstraintAngleOrDistance, ThirdConstraint, ThirdConstraintAngleOrDistance)
and

Before calling this method, you must have selected the reference entities using these marks with IModelDocExtension::SelectByID2:

0 = First reference entity
1 = Second reference entity
2 = Third reference entity

Kind regards

ixxs71 · September 24, 2021, 1:59pm

If I understand your clue I have to do this

boolstatus = Part.Extension.SelectByID2(swEnt, "????", 0, 0, 0, True, 1, Nothing, 0)

What do I place instead of ????

JeromeP · September 24, 2021, 5:55pm

Hello

To select the face, you can use:

Dim swEntity As SldWorks.entity
Set swEntity = swEnt
Dim swSelectData As SldWorks.SelectData
Set swSelectData = swSelectionMgr.CreateSelectData
swSelectData.mark = 1
swEntity.Select4 True, swSelectData

Maclane · September 27, 2021, 6:28am

Hello;

the "InsertRefPlane" function automatically takes the previous selections in order.
Except for convenience, it is not necessary to name them. you just have to tell "InsertRefPlane" what you want to do with it:

For example: the macro below

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object

Part.ClearSelection2 True

Set swModelView = Part.ActiveView
Ref1 = Part.Extension.SelectByRay(7.22190712104975E-02, 9.98370992863329E-03, 0.304415424010585, -0.774421370181801, -0.406469481117021, -0.484823784818983, 1.56729303225411E-03, 1, True, 0, 0)
ref2 = Part.Extension.SelectByRay(-7.86713451373089E-03, -6.76744786841255E-02, 0.304799999999886, -0.774421370181801, -0.406469481117021, -0.484823784818983, 1.56729303225411E-03, 2, True, 1, 0)
Dim myRefPlane As Object
Set myRefPlane = Part.FeatureManager.InsertRefPlane(4, 0, 16, 1.39626340159547, 0, 0)

Part.ClearSelection2 True
End Sub

Equivalent to:
Creation of a new plane: Coincident (4) and (0) to my first selection (Ref1) with an angle of 80° (16) and (1.39626340159547) to my second selection...
In your case InsertRefPlane(32,0,2,0,0,0) = tangent to the first selection and then perpendicular to the second selection.

The values determining the type of constraints are listed here help.solidworks.com

swRefPlaneReferenceConstraint_Angle	16 or 0x10
swRefPlaneReferenceConstraint_Coincident	4 or 0x4
swRefPlaneReferenceConstraint_Distance	8 or 0x8
swRefPlaneReferenceConstraint_MidPlane	128 or 0x80
swRefPlaneReferenceConstraint_OptionFlip	256 or 0x100
swRefPlaneReferenceConstraint_OptionOriginOnCurve	512 or 0x200
swRefPlaneReferenceConstraint_OptionProjectAlongSketchNormal	2056 or 0x800
swRefPlaneReferenceConstraint_OptionProjectToNearestLocation	1028 or 0x400
swRefPlaneReferenceConstraint_OptionReferenceFlip	8192 Gold 0x2000
swRefPlaneReferenceConstraint_Parallel	1 or 0x1
swRefPlaneReferenceConstraint_ParallelToScreen	4096 or 0x1000
swRefPlaneReferenceConstraint_Perpendicular	2 or 0x2
swRefPlaneReferenceConstraint_Project	64 or 0x40
swRefPlaneReferenceConstraint_Tangent	32 or 0x20

Kind regards

ixxs71 · September 27, 2021, 7:04am

@Maclane @JeromeP

Thank you for your answers, I'll look at it tonight. I had a busy weekend to dive back into my development. I'll keep you informed anyway

d.roger · September 29, 2021, 11:36am

Hello

Since swEnt is a face , you can retrieve it using the IsSame function at the moment you need it. Be careful, the 3D model must not be rebuilt before calling this function, otherwise it will not work (prefer the use of swModel.GraphicsRedraw2 if necessary).

Set swSelData = swModel.SelectionManager.CreateSelectData
Set swPart = swModel
vBodies = swPart.GetBodies2(swAllBodies, True)
Set swBody = vBodies(0)
Set swFace = swBody.GetFirstFace
Do While Not swFace Is Nothing
   status = swFace.IsSame(swEnt)
   If status Then
       swFace.Select4 True, swSelData
       Exit Do
   End If
   Set swFace = swFace.GetNextFace
Loop

Another solution would be to name this face:

    Set swEnt = swModel.SelectionManager.GetSelectedObject6(1, -1)
    Do While swEnt Is Nothing
        DoEvents
        Set swEnt = swModel.SelectionManager.GetSelectedObject6(1, -1)
    Loop

    faceName = "MaFace"

    Set swBody = swEnt.GetBody

    BodyName = swBody.Name

    status = swModel.SelectedFaceProperties(0, 0, 0, 0, 0, 0, 0, True, faceName)

then search for it by its little name when you need it.

    Set swSelData = swModel.SelectionManager.CreateSelectData
    Set swPart = swModel
    vBodies = swPart.GetBodies2(swAllBodies, True)
    Set swBody = vBodies(0)
    Set swFace = swBody.GetFirstFace
    Do While Not swFace Is Nothing
        currentFaceName = swModel.GetEntityName(swFace)
        If (currentFaceName = faceName) Then
            swFace.Select4 True, swSelData
            Exit Do
        End If
        Set swFace = swFace.GetNextFace
    Loop

Kind regards

d.roger · September 29, 2021, 11:50am

Which for example can give this on the attachment:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swPart As PartDoc
Dim swBody As SldWorks.Body2
Dim vBodies As Variant
Dim theFeature As SldWorks.Feature
Dim swFeature As SldWorks.Feature
Dim myFeature As SldWorks.Feature
Dim skSegment As SldWorks.SketchSegment
Dim myRefPlane As SldWorks.RefPlane
Dim swEnt As SldWorks.Face2
Dim swFace As SldWorks.Face2
Dim swSelData As SldWorks.SelectData
Dim status As Boolean
Dim faceName As String
Dim BodyName As String
Dim AxeName As String
Dim PlanName As String
Dim currentFaceName As String
Dim featCount As Long
Dim featName As String
Dim i As Long

Sub main()
    On Error GoTo Handler

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    swModel.ClearSelection2 True

    Set swEnt = swModel.SelectionManager.GetSelectedObject6(1, -1)
    Do While swEnt Is Nothing
        DoEvents
        Set swEnt = swModel.SelectionManager.GetSelectedObject6(1, -1)
    Loop

    status = swModel.InsertAxis2(True)
    
    If status = False Then
        MsgBox "Il n'est pas possible de créer un axe sur cette sélection."
        swModel.ClearSelection2 True
        Exit Sub
    End If

    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True

    featCount = swModel.GetFeatureCount
    Set theFeature = swModel.FeatureByPositionReverse(0)
    If Not theFeature Is Nothing Then
        featName = theFeature.Name
    End If

    AxeName = "MonAxe"
    status = swModel.Extension.SelectByID2(featName, "AXIS", 0, 0, 0, False, 0, Nothing, 0)
    status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, AxeName)
    i = 0
    Do While status = False
        i = i + 1
        AxeName = "MonAxe" & i
        status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, AxeName)
    Loop

    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True

    '************************************************************
    'Ajout d'un usinage pour test
    '************************************************************
    status = swModel.Extension.SelectByID2("Plan de droite", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    swModel.SketchManager.InsertSketch True
    Set skSegment = swModel.SketchManager.CreateCircle(-0.04, 0#, 0#, -0.03, 0.01, 0#)
    
    swModel.ViewOrientationUndo
    
    Set myFeature = swModel.FeatureManager.FeatureCut4(False, False, False, 9, 1, 0.001, 0.001, False, False, False, False, 0, 0, False, False, False, False, False, True, True, True, True, False, 0, 0, False, False)
    swModel.SelectionManager.EnableContourSelection = False
    
    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True
    
    If myFeature Is Nothing Then
        MsgBox "Usinage impossible : la géométrie ne croise pas le modèle."
        swModel.EditUndo2 2
    End If

    '************************************************************
    'Plan coincident 1 axe et perpendiculaire 1 plan de référence
    '************************************************************
    status = swModel.Extension.SelectByID2(AxeName, "AXIS", 0, 0, 0, True, 0, Nothing, 0)
    status = swModel.Extension.SelectByID2("Plan de dessus", "PLANE", 0, 0, 0, True, 1, Nothing, 0)

    Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 2, 0, 0, 0)

    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True

    featCount = swModel.GetFeatureCount
    Set theFeature = swModel.FeatureByPositionReverse(0)
    If Not theFeature Is Nothing Then
        featName = theFeature.Name
    End If

    PlanName = "MonPlan"
    status = swModel.Extension.SelectByID2(featName, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, PlanName)
    i = 0
    Do While status = False
        i = i + 1
        PlanName = "MonPlan" & i
        status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, PlanName)
    Loop
    
    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True

    '****************************************************
    'Plan tangent à ma face et perpenticulaire à mon plan
    '****************************************************
    Set swSelData = swModel.SelectionManager.CreateSelectData
    Set swPart = swModel
    vBodies = swPart.GetBodies2(swAllBodies, True)
    Set swBody = vBodies(0)
    Set swFace = swBody.GetFirstFace
    Do While Not swFace Is Nothing
        status = swFace.IsSame(swEnt)
        If status Then
            swFace.Select4 True, swSelData
            Exit Do
        End If
        Set swFace = swFace.GetNextFace
    Loop
    
    status = swModel.Extension.SelectByID2(PlanName, "PLANE", 0, 0, 0, True, 1, Nothing, 0)

    Set myRefPlane = swModel.FeatureManager.InsertRefPlane(32, 0, 2, 0, 0, 0)

    swModel.GraphicsRedraw2
    swModel.ClearSelection2 True
    
    featCount = swModel.GetFeatureCount
    Set theFeature = swModel.FeatureByPositionReverse(0)
    If Not theFeature Is Nothing Then
        featName = theFeature.Name
    End If
    
    status = swModel.Extension.SelectByID2(featName, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, PlanName)
    i = 0
    Do While status = False
        i = i + 1
        PlanName = "MonPlan" & i
        status = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, True, False, PlanName)
    Loop
    
    swModel.ForceRebuild3 True
    swModel.ClearSelection2 True
    
    MsgBox "Traitement terminé."
    
    Exit Sub
    
Handler:
    MsgBox "Traitement terminé sur erreur."
    swModel.ClearSelection2 True
    Exit Sub
End Sub

macroselectface.sldprt

ixxs71 · September 29, 2021, 12:01pm

@d.Roger respect!

I'm running during the day with my new permanent contract and in the evening with my former clients who don't let go of me (I'm not complaining, eh) and you give me a whole development on my problem!

I'm really going to have to free up time to look at this, at least to honor your work and by extension to all those who, by their answers, make the schmilblick move forward!