VBA - Handmatige selectie van een te extruderen onderdeel

Out of category
1

Hallo

Ik heb enige noties van VBA, wetende dat ik al veel toepassingen in Excel heb gemaakt.

Aan de andere kant, VBA SolidWorks, schijt ik een beetje...

Ik heb een van mijn klanten die regelmatig trekvaten bij mij bestelt. Bovenop de vaten heb ik het grootste deel van mijn stiksels liggen. Ik maak een macro die automatisch EEN stiksel maakt. Ik open een gebruikersformulier met verschillende gegevens om in te vullen zoals de hoek van het boren, de diameter, de dikte van de kraan etc.

Tot nu toe gaat alles goed, ik krijg de info, ik maak mijn schets die ik citeer. 

En dit is waar het vastloopt: ik wil het object selecteren waar ik een gat in wil maken omdat ik het niet direct kan benoemen. Inderdaad, als ik nog een steek wil positioneren, is het object in kwestie van naam veranderd (de)!

Helaas, wanneer ik het onderdeel selecteer, is er geen manier om te slagen in de extrusie!  en ik kan niet vinden waarom!

Ik presenteer u het deel van mijn code dat bugs bevat (ik had het hele script geplaatst, maar ik overschreed de limiet van 6000 tekens)

Als iemand een idee heeft en het mij kan uitleggen, ben ik er helemaal voor...


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

Hallo

Om de limiet van het aantal tekens te omzeilen, is de eenvoudigste manier om het swp-bestand direct als bijlage beschikbaar te maken.

Het zou ons in staat stellen om te testen en te helpen begrijpen zonder een compleet stuk code opnieuw te doen:)

3

Hallo

 

Van mijn kant, wanneer ik elementen moet selecteren, gebruik ik dit type 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 dit geval selecteer ik een vlak, maar het gaat hetzelfde met een gezicht waarmee je de bijbehorende functie ophaalt .

 

In de hoop dat dit je kan helpen.

 

A. Mendes

 

4

Dank u voor uw reactievermogen. 

@Cyril.F : Inderdaad, dat zal ik meteen corrigeren.

In PJ de .prt waar ik op aan het experimenteren ben en de .swt

@A.Mendes : bedankt voor het fragment. Ik ga het vanavond testen met een uitgerust hoofd om het te begrijpen.


00000000_test_cpr.sldprt
test_piquage.swp
5

@A.Mendes , na het bekijken en testen van je code denk ik niet dat het aan mijn behoeften voldoet: ik probeer op het object te klikken waarop ik wil extruderen. Als ik uw code goed heb begrepen, controleert het of uw selectie van het type is dat u wilt.

6

Het lijkt niet veel mensen te inspireren... Ik blijf op mijn zij kijken, maar ik droog op met een kracht! En wat niet helpt, is dat er niet veel tutorials of uitleg online zijn...

7

Hallo

Op dit moment niet al te veel tijd om te testen. Ik had een eerste macro stop op de onderstaande regel:

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

Had geen tijd om veel meer te onderzoeken.

8

Ik kijk vanavond, maar ik denk dat ik moet zijn gecrasht in een van de 2 meegeleverde bestanden. Ik werk aan 2 versies tussen 2 stuks... Kortom, het helpt niet om het probleem te vervroegen. 

9

Hallo;

Voor de selectie van een onderdeel (in een assembly) gebruik ik:

    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

 

Vriendelijke groeten

1 like
10

Ik had het een beetje druk gisteravond...

Ik geef je de juiste elementen in de pc.

@Maclane: Ik weet niet of het mijn probleem beantwoordt, maar ik zal het testen. 


test_piquage.swp
test_piquage.sldprt
11

  @Ixxs71 Sorry voor de vertraging bij het antwoorden.

Ja, in mijn code controleer ik of de selectie overeenkomt met mijn behoeften. Maar ik moet het vinden, ik moet een code hebben die als je op een gezicht klikt hem krijgt. Daarna zou u in staat moeten zijn om de functie die bij het gezicht hoort te herstellen.

Ik probeer zo snel mogelijk te kijken.

 

12

RE: Ik heb me er meteen in verdiept, want daarna wordt het heel ingewikkeld voor mij

            ' 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

 

Voor mij als je test in plaats van de faceentity.getcomponent een regel

Functie instellen = Face.getFunctie met de variabele functie = een variabele van het type functie die je zou moeten beginnen om op je voeten te kunnen landen.

In de hoop dat dit je in de goede richting kan brengen.

 

A. Mendes

 

13

Hallo

Ik kon uw onderdeel niet laden vanwege een toekomstige versie...

Laten we eens kijken of dit u kan helpen en uitgaande van het voorbeeld dat in de help (ICI) aanwezig is:

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

Dit zal een voorbeeldbestand laden (niet om op te slaan nadat de macro is verstreken) en vervolgens zal de macro in de wacht worden gezet terwijl het een gezicht selecteert, vervolgens een schets maken met een cirkel op dit gezicht en deze ponsen.

Vriendelijke groeten

1 like
14

Ik hou je op de hoogte van wat me wel of niet gaat lukken.

Op dit moment besteed ik mijn avonden aan klantprojecten, dus mijn verbeterprojecten zijn een beetje secundair, maar ik wanhoop niet om er dit weekend weer mee aan de slag te gaan. In ieder geval bedankt voor de tijd die je aan mij besteedt.

15

Hallo

En hier is een voorbeeld met selectie op het actieve deel in SW en controleren of de geometrie voor de extrusie het model kruist:

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

Vriendelijke groeten

1 like
16

Ik ben er eindelijk in geslaagd om mijn probleem op te lossen: door je stukjes script te lezen en tests uit te voeren, begreep ik dat ik de naam van het lichaam van het geselecteerde gezicht moest krijgen om de extrusie te laten werken.  

Het ziet er dus zo uit: 

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

 

Bedankt allemaal voor de hulp.