VBA - Manual selection of a part to be extruded

Out of category
1

Hello

I have some notions of VBA knowing that I have already made a lot of applications in excel.

On the other hand, VBA SolidWorks, I shit a little...

I have one of my customers who regularly orders drawing vats from me. On top of the vats, I have most of my stitching. I'm making a macro that will automatically create ONE stitching. I open a userform with different information to fill in such as the angle of the drilling, the diameter, the thickness of the tap etc.

So far, everything goes well, I get the info, I create my sketch that I quote. 

And this is where it gets stuck: I want to select the object that I want to make a hole in because I can't name it directly. Indeed, when I want to position another stitch, the object in question will have changed its name (the idiot)!

Unfortunately, when I select the part, there is no way to succeed in the extrusion!  and I can't find why!

I present to you the part of my code that bugs (I had put the entire script but I exceeded the limit of 6000 characters)

If someone has an idea and can explain it to me, I'm all for it...


'*****************************************************
'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

Hello

To overcome the limit of the number of characters, the easiest way is to make the swp file available directly as an attachment.

It would allow us to test and help understand without redoing a complete piece of code:)

3

Hello

 

For my part, when I have to select elements, I use this type of 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

 

 

In this case I select a plane but it goes the same with a face with which you retrieve the associated function.

 

Hoping that this can help you.

 

A. Mendes

 

4

Thank you for your responsiveness. 

@Cyril.F : Indeed, I'll correct that right away.

In PJ the .prt on which I am experimenting and the .swt

@A.Mendes : thanks for the snippet. I'm going to test it tonight with a rested head to understand it.


00000000_test_cpr.sldprt
test_piquage.swp
5

@A.Mendes after looking at and testing your code I don't think it meets my needs: I try to click on the object I want to extrude on. If I understood your code correctly, it checks that your selection is of the type you want.

6

it doesn't seem to inspire many people... I continue to look on my side but I am drying up with a power! And what doesn't help is that there aren't many tutorials or explanations online...

7

Hello

Not too much time to test at the moment. I had a first macro stop on the line below:

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

Didn't have time to investigate much more.

8

I'm watching tonight, but I think I must have crashed in one of the 2 files provided. I'm working on 2 versions between 2 pcs... In short, it doesn't help to advance the problem. 

9

Hello;

For the selection of a part (in an assembly) I use:

    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

 

Kind regards

1 Like
10

I was a little busy last night...

I'll give you the right elements in the PC.

@Maclane: I don't know if it answers my problem but I'll test. 


test_piquage.swp
test_piquage.sldprt
11

  @Ixxs71 Sorry for the delay in replying.

Yes, in my code, I check that the selection corresponds to my needs. But I have to find it, I must have a code that when you click on a face gets it. Afterwards you should be able to recover the function associated with the face.

I try to look as quickly as possible.

 

12

RE I looked into it right away because after that it will be very complicated for me

            ' 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

 

For me if you test instead of the faceentity.getcomponent a line

set function = face.getfeature with the variable function = a variable of the type feature you should start to be able to land on your feet.

Hoping that this can take you in the right direction.

 

A. Mendes

 

13

Hello

I couldn't load your part because of a future version...

Let's see if this can help you and starting from the example present in the help (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

This will load an example file (not to be saved after the macro has passed) and then the macro will go on hold while it selects a face, then create a sketch with a circle on this face and punch it.

Kind regards

1 Like
14

I'll keep you informed of what I'm going to succeed in doing or not.

For the moment, my evenings are spent on client projects, so my improvement projects are a bit secondary, but I don't despair of getting back to it this weekend. In any case, thank you for the time you devote to me.

15

Hello

And here is an example with selection on the active part in SW and checking if the geometry for the extrusion crosses the model:

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

Kind regards

1 Like
16

I finally managed to solve my problem: by dint of reading your bits of scripts and doing tests, I understood that I had to get the name of the body of the selected face for the extrusion to work.  

So, it looks like this: 

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

 

Thank you all for the help.