VBA - Assigner à une variable une sélection manuelle

Bonjour,

A partir d'une sélection tel que ce 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

je souhaite réaliser une première opération et pluôt que de refaire une sélection pour pointer la même face, est il possible de placer le résultat du pointage dans une variable ? et comment appeler cette sélection pour réaliser la nouvelle opération ?

j'espère avoir été suffisament clair...

Bonjour,

"est il possible de placer le résultat du pointage dans une variable ?" : c'est déjà ce que tu fais puisque tu stocke ta sélection dans la variable swEnt, donc tant que ta macro est en cours de fonctionnement, que tu ne réinitialise pas cette variable ou que tu ne lui affecte pas une nouvelle valeur ...

Cordialement,

Yep, je suis ok avec le principe, mais je pointe sur cette variable comment par la suite ? (voir commentaire en fin de 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)

 

​

 

Bonjour;

Un indice  = https://help.solidworks.com/SOLIDWORKS.Interop.sldworks~SOLIDWORKS.Interop.sldworks.IFeatureManager~InsertRefPlane.html
avec

.InsertRefPlane(FirstConstraint, FirstConstraintAngleOrDistance _
, SecondConstraint, SecondConstraintAngleOrDistance, ThirdConstraint, ThirdConstraintAngleOrDistance)
et

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


Cordialement
 

 

Si je comprends ton indice je dois faire cela

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

 

Je place quoi à la place des ????

Bonjour,

Pour sélectionner la face, tu peux utiliser:

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

 

1 « J'aime »

Bonjour;

la fonction"InsertRefPlane" prend automatiquement, et dans l'ordre, les sélections précédentes.
Sauf par commodité il n'est pas necessaire de les nommer. il faut simplement dire à "InsertRefPlane" ce que tu souhaite en faire:

Par exemple: la macro ci dessous

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

équivaut à:
Création d'un nouveau plan : Coincident (4) et (0) à ma première sélection (Ref1) avec un angle de 80° (16) et (1.39626340159547) à ma seconde sélection...
Dans ton cas InsertRefPlane(32,0,2,0,0,0) = tangent à la première sélection puis perpendiculaire à la seconde sélection.

les valeurs déterminant le type de contraintes sont enumerées ici help.solidworks.com

swRefPlaneReferenceConstraint_Angle16 or 0x10
swRefPlaneReferenceConstraint_Coincident4 or 0x4
swRefPlaneReferenceConstraint_Distance8 or 0x8
swRefPlaneReferenceConstraint_MidPlane128 or 0x80
swRefPlaneReferenceConstraint_OptionFlip256 or 0x100
swRefPlaneReferenceConstraint_OptionOriginOnCurve512 or 0x200
swRefPlaneReferenceConstraint_OptionProjectAlongSketchNormal2056 or 0x800
swRefPlaneReferenceConstraint_OptionProjectToNearestLocation1028 or 0x400
swRefPlaneReferenceConstraint_OptionReferenceFlip8192 or 0x2000
swRefPlaneReferenceConstraint_Parallel1 or 0x1
swRefPlaneReferenceConstraint_ParallelToScreen4096 or 0x1000 
swRefPlaneReferenceConstraint_Perpendicular2 or 0x2
swRefPlaneReferenceConstraint_Project64 or 0x40
swRefPlaneReferenceConstraint_Tangent32 or 0x20

Cordialement

1 « J'aime »

@Maclane  @JeromeP 

Merci pour vos réponses, je vais regarder cela ce soir. J'ai eu un week end un peu chargé pour me replonger dans mon développement. Je vous tiens au courant quoi qu'il en soit

Bonjour,

swEnt étant une face  tu peux la récupérer à l'aide de la fonction IsSame au moment ou tu en as besoin. Attention, il ne faut pas que le modèle 3D est été reconstruit avant l'appel de cette fonction sinon cela ne fonctionne pas (préférer l'utilisation de swModel.GraphicsRedraw2 au besoin).

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

Une autre solution consisterai à nommer cette 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)

puis la rechercher par son petit nom au moment ou tu en as besoin.

    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

Cordialement,

1 « J'aime »

Ce qui par exemple peut donner ça sur la pièce jointe :

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
1 « J'aime »

@d.roger respect !

Je suis en train de courir en journée avec mon nouveau CDI et en soirée avec mes anciens clients qui ne me lachent pas (je ne me plains pas, hein) et toi tu me fais tout un développement sur ma problématique !

Va vraiment falloir que j'arrive à me libérer du temps pour regarder cela au moins pour honorer ton travail et par extension à tous ceux qui par leurs réponses font avancer le schmilblick !