VBA - Sélection manuelle d'une pièce à extruder

Out of category
1

Bonjour,

J'ai quelques notions de VBA sachant que j'ai déjà réalisé pas mal d'applications sous excel.

Par contre VBA SolidWorks, j'en chie un peu...

J'ai un de mes clients qui me commande régulièrement des cuves à dessiner. Sur le dessus des cuves, j'ai la plupart de mes piquages. Je suis en train de faire une macro qui va me créer en automatique UN piquage. J'ouvre une userform avec différentes informations à renseigner comme l'angle du perçage, le diamètre, l'épaisseur du piquage etc.

Jusque là, tout ce passe bien, je récupère les info, je créé mon esquisse que je cote. 

Et c'est là que ça coince : je veux sélectionner l'objet dans lequel je veux faire un trou car je ne peux pas le nommer directement. En effet quand je vais vouloir positionner un autre piquage, l'objet en question aura changé de nom (le con) !

Malheureusement, quand je sélectionne la pièce, pas moyen de réussir l'extrusion !  et je n'arrive pas à trouver pourquoi !

Je vous présente la partie de mon code qui bug (J'avais mis la totalité du script mais je dépassais la limite des 6000 caractères)

Si quelqu'un à une idée et arrive à me l'expliquer, je suis preneur...


'*****************************************************
'Enlèvement matière
'*****************************************************

MsgBox "Sélection du cône à extruder"

Dim Feature As Object
Set Feature = Part.SelectionManager.GetSelectedObject6(1, 0)
Do While Feature Is Nothing
    DoEvents
    Set Feature = Part.SelectionManager.GetSelectedObject6(1, 0)
Loop

Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureCut4(True, False, False, 1, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, False, True, False, True, True, False, 0, 0, False, False)

 

2

Bonjour,

Pour palier à la limite du nombre de caractère, le plus simple est de mettre à dispo le fichier swp à dispo directement en pièce jointe.

Ca permettrait de tester et aider à comprendre sans refaire un bout de code complet :)

3

BOnjour

 

Pour ma part lorsque je dois sélectionner des éléments je passe par ce type de code.

Dim featmananger As SldWorks.FeatureManager
Set featmananger = noeud.FeatureManager
Dim feat As SldWorks.Feature
Set feat = noeud.FirstFeature
Dim subfeat As SldWorks.Feature


Do While Not feat Is Nothing
    If feat.GetTypeName2 = "RefPlane" Then
        nb_plan = nb_plan + 1
    End If
    If feat.GetTypeName2 = "FtrFolder" Then
        Set subfeat = feat.GetFirstSubFeature
        Do While Not subfeat Is Nothing
            If subfeat.GetTypeName2 = "RefPlane" Then
                nb_plan = nb_plan + 1
            End If
        
        Loop
    End If
Set feat = feat.GetNextFeature
Loop

 

 

En l'occurence je sélectionne un plan mais cela va de même avec une face avec laquelle tu récupères la fonction associée.

 

En esperant que cela puisse t'aider.

 

A. Mendes

 

4

Merci pour votre réactivité. 

@Cyril.f : effectivement, je corrige cela de suite.

En PJ le .prt sur lequel je fais mes essais et le .swt

@A.Mendes : merci pour le bout de code. Je vais le tester ce soir à tête reposé pour le comprendre.


00000000_test_cpr.sldprt
test_piquage.swp
5

@A.Mendes après avoir regardé et testé ton code je ne pense pas qu'il réponde à mon besoin : je cherche à cliquer sur l'objet sur lequel je souhaite extruder. Si j'ai bien compris ton code, celui ci vérifie que ta sélection est du type que tu veux.

6

ça n'a pas l'air d'inspirer beaucoup de monde... je continue de chercher de mon côté mais je sèche d'une puissance ! Et ce qui n'aide pas c'est qu'il n'y a pas beaucoup de tuto ou d'explications en ligne ...

7

Bonjour,

Pas trop le temps de tester en ce moment. J'ai eu un premier arrêt de la macro sur la ligne ci-dessous:

myDimension.SystemValue = Part.Parameter("rayon_ext@Esquisse1").SystemValue - (Distance_Bord_ / 1000)

Pas eu le temps d'investiguer beaucoup plus.

8

Je regarde ce soir, mais je pense que j'ai dû me planter dans un des 2 fichiers fournis. Je bosse sur 2 versions entre 2 pc... bref ça aide pas à faire avancer le problème. 

9

Bonjour;

Pour la sélection d'une pièce (dans un assemblage) j'utilise:

    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim SelObj As Object
    Dim swComp As SldWorks.Component2
    Dim sActiveConfigName As String
    Dim SelecNameS As String


Set SelObj = swSelMgr.GetSelectedObject6(1, -1)
    If TypeOf SelObj Is SldWorks.Component2 Then Set swComp = swSelMgr.GetSelectedObject6(1, -1) 'Si la selection est faite depuis l'arbre de creation
    If TypeOf SelObj Is SldWorks.Face2 Then Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1) 'Si la selection est faite depuis une face
   
    SelecNameS = swComp.GetSelectByIDString      'Recuperation du Nom de la selection et du Nom du fichier actif
    sActiveConfigName = swComp.ReferencedConfiguration 'Recuperation du Nom de la configuration Active

 

Cordialement

1 « J'aime »
10

J'étais un peu occupé hier soir...

Je vous remets les bons éléments en PJ.

@Maclane : je ne sais pas si ça répond à ma problématique mais je vais tester.


test_piquage.swp
test_piquage.sldprt
11

@Ixxs71  Désolé pour le retard dans la réponse.

Oui dans mon code je vérifie que la sélection corresponde a mon besoin. Mais il faut que je retrouve je dois avoir un code qui lorsque tu clique sur une face la récupère. Par la suite tu dois pouvoir récupérer la fonction associée à la face.

J'essai de regarder au plus vite.

 

12

RE je me suis penché dessus tout de suite car apres cela sera tres compliqué pour moi

            ' boucle pour attente selection
    
                bool1 = False
                Do Until bool1 = True
                    If Selectmanager.GetSelectedObjectType3(1, -1) = 2 Then
                    bool1 = True
                    End If
                    For y = 1 To 50000
                    DoEvents
                    Next y
                Loop
    
            'recup le nom de la piece selectionnée
    
            Set face = Selectmanager.GetSelectedObject6(1, -1)
            Set faceEntity = face
            Set comp = faceEntity.GetComponent
            'Debug.Print comp.Name2
            Set ossature = comp
            Set ossaturemodeldoc = ossature.GetModelDoc2
            oss = comp.Name2

 

Pour moi si tu test a la place du faceentity.getcomponent une ligne

set fonction = face.getfeature avec la variable fonction = une variable du type feature tu devrais commencer à pouvoir retomber sur tes pieds.

En espérant que cela puisse t'emmener dans la bonne voie.

 

A. Mendes

 

13

Bonjour,

Je n'ai pas pu charger ta pièce pour cause de version future ...

A voir si cela peut t'aider et en partant de l'exemple présent dans l'aide (ICI) :

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSketchManager As SldWorks.SketchManager
Dim swSketchSegment As SldWorks.SketchSegment
Dim swFeatureManager As SldWorks.FeatureManager
Dim swFeature As SldWorks.Feature
Dim swExtrudeFeatureData As SldWorks.ExtrudeFeatureData2
Dim status As Boolean
Dim errors As Long
Dim warnings As Long

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2019\samples\tutorial\api\2012-sm.sldprt", swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)

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

    swModel.ClearSelection2 True
    
    status = swEnt.Select4(True, swSelData)
    
    'Sketch a circle
    Set swSketchManager = swModel.SketchManager
    Set swSketchSegment = swSketchManager.CreateCircle(0#, 0#, 0#, 0.004122, -0.003029, 0#)

    Set swFeatureManager = swModel.FeatureManager
    Set swFeature = swFeatureManager.FeatureCut4(True, False, False, 1, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, True, True, False, 0, 0, False, False)

    swModel.ClearSelection2 True

    MsgBox "Terminé"
End Sub

Cela va charger un fichier exemple (à ne pas sauvegarder après le passage de la macro) puis la macro va se mettre en attente le temps de sélectionner une face puis créer une esquisse avec un cercle sur cette face et la poinçonner.

Cordialement,

1 « J'aime »
14

Je vous tiens au courant de ce que je vais réussir à faire ou pas.

Pour le moment, mes soirées passe sur des projets clients, du coup mes projets d'amélioration passe un peu au second plan, mais je ne désespère pas de m'y remettre ce week end. En tous les cas merci pour le temps que vous me consacrez.

15

Bonjour,

Et voici un exemple avec sélection sur la pièce active dans SW et vérification si la géométrie pour l'extrusion croise bien le modèle :

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchSegment As SldWorks.SketchSegment
Dim swFeature As SldWorks.Feature
Dim swEnt As SldWorks.Entity
Dim swSelData As SldWorks.SelectData
Dim status As Boolean

Sub main()

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

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

    swModel.ClearSelection2 True
    
    status = swEnt.Select4(True, swSelData)
    
    Set swSketchSegment = swModel.SketchManager.CreateCircle(0.023541, -0.016804, 0#, 0.029591, -0.01168, 0#)

    Set swFeature = swModel.FeatureManager.FeatureCut4(True, False, False, 1, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False, False)

    swModel.ClearSelection2 True
    
    If Not swFeature Is Nothing Then
        MsgBox "Terminé"
    Else
        MsgBox "La géométrie ne croise pas le modèle."
        swModel.EditUndo2 3
    End If
End Sub

Cordialement,

1 « J'aime »
16

J'ai réussi enfin à résoudre mon problème : à force de lire vos bout de scripts et de faire des tests, j'ai compris qu'il fallait que récupère le nom du corps de la face sélectionné pour que l'extrusion fonctionne.  

Du coup, ça donne cela : 

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


Dim swBody As SldWorks.Body2
Set swBody = swEnt.GetBody

boolstatus = Part.Extension.SelectByID2(swBody.Name, "SOLIDBODY", 0, 0, 0, True, 8, Nothing, 0)

Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureCut4(True, False, False, 1, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, False, True, False, True, True, False, 0, 0, False, False)
Part.ClearSelection2 True

 

Merci à tous pour le coup de main.