VBA - Manuelle Auswahl eines zu extrudierenden Teils

Out of category
1

Hallo

Ich habe einige Vorstellungen von VBA, da ich bereits viele Anwendungen in Excel erstellt habe.

Auf der anderen Seite, VBA SolidWorks, ich scheiße ein bisschen...

Ich habe einen meiner Kunden, der regelmäßig Ziehbottiche bei mir bestellt. Oben auf den Bottichen habe ich die meisten meiner Nähte. Ich erstelle ein Makro, das automatisch EINE Naht erstellt. Ich öffne ein Benutzerformular mit verschiedenen Informationen zum Ausfüllen, wie z. B. dem Winkel der Bohrung, dem Durchmesser, der Dicke des Gewindebohrers usw.

Bisher läuft alles gut, ich bekomme die Infos, ich erstelle meine Skizze, die ich zitiere. 

Und hier bleibt es hängen: Ich möchte das Objekt auswählen , in das ich ein Loch machen möchte, weil ich es nicht direkt benennen kann. In der Tat, wenn ich einen weiteren Stich positionieren möchte, hat das betreffende Objekt seinen Namen geändert (der Idiot)!

Leider gibt es bei der Auswahl des Teils keine Möglichkeit, die Extrusion erfolgreich durchzuführen!  und ich kann nicht finden, warum!

Ich stelle Ihnen den Teil meines Codes vor, der Fehler aufweist (ich hatte das gesamte Skript eingefügt, aber ich habe das Limit von 6000 Zeichen überschritten)

Wenn jemand eine Idee hat und sie mir erklären kann, bin ich dafür...


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

Um die Begrenzung der Zeichenzahl zu umgehen, ist es am einfachsten, die swp-Datei direkt als Anhang zur Verfügung zu stellen.

Es würde uns ermöglichen, zu testen und zu verstehen, ohne ein komplettes Stück Code neu zu erstellen:)

3

Hallo

 

Wenn ich Elemente auswählen muss, verwende ich diese Art von 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 diesem Fall wähle ich eine Ebene aus, aber das Gleiche gilt für eine Fläche, mit der Sie die zugehörige Funktion abrufen .

 

In der Hoffnung, dass dies Ihnen helfen kann.

 

A. Mendes

 

4

Vielen Dank für Ihre Reaktionsfähigkeit. 

@Cyril.F : Ja, das werde ich gleich korrigieren.

In PJ die .prt, mit der ich experimentiere, und die .swt

@A.Mendes : Danke für das Snippet. Ich werde es heute Abend mit einem ausgeruhten Kopf testen, um es zu verstehen.


00000000_test_cpr.sldprt
test_piquage.swp
5

@A.Mendes , nachdem ich mir Ihren Code angesehen und getestet habe, glaube ich nicht, dass er meinen Anforderungen entspricht: Ich versuche, auf das Objekt zu klicken, auf das ich extrudieren möchte. Wenn ich Ihren Code richtig verstanden habe, wird überprüft, ob Ihre Auswahl dem gewünschten Typ entspricht.

6

Es scheint nicht viele Menschen zu inspirieren... Ich schaue weiterhin auf meine Seite, aber ich trockne mit einer Kraft aus! Und was nicht hilft, ist, dass es nicht viele Tutorials oder Erklärungen online gibt...

7

Hallo

Im Moment nicht allzu viel Zeit zum Testen. Ich hatte einen ersten Makro-Stopp auf der folgenden Linie:

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

Ich hatte keine Zeit, viel mehr zu untersuchen.

8

Ich schaue mir das Spiel heute Abend an, aber ich glaube, ich muss in einer der 2 bereitgestellten Dateien abgestürzt sein. Ich arbeite an 2 Versionen zwischen 2 Stück... Kurz gesagt, es hilft nicht, das Problem voranzutreiben. 

9

Hallo;

Für die Auswahl eines Teils (in einer Baugruppe) verwende ich:

    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

 

Herzliche Grüße

1 „Gefällt mir“
10

Ich war letzte Nacht ein wenig beschäftigt...

Ich gebe Ihnen die richtigen Elemente auf dem PC.

@Maclane: Ich weiß nicht, ob es mein Problem löst, aber ich werde es testen. 


test_piquage.swp
test_piquage.sldprt
11

  @Ixxs71 Entschuldigung für die Verzögerung bei der Antwort.

Ja, in meinem Code überprüfe ich, ob die Auswahl meinen Bedürfnissen entspricht. Aber ich muss ihn finden, ich muss einen Code haben, der ihn erhält, wenn man auf ein Gesicht klickt. Danach sollten Sie in der Lage sein, die mit dem Gesicht verbundene Funktion wiederherzustellen.

Ich versuche, so schnell wie möglich zu schauen.

 

12

RE: Ich habe mich sofort damit beschäftigt, denn danach wird es für mich sehr kompliziert

            ' 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

 

Für mich, wenn Sie anstelle der faceentity.getcomponent eine Zeile testen

set function = face.getfeature mit der Variablen function = eine Variable vom Typ feature, sollten Sie beginnen, auf Ihren Füßen zu landen.

In der Hoffnung, dass dies Sie in die richtige Richtung führen kann.

 

A. Mendes

 

13

Hallo

Ich konnte Ihr Teil wegen einer zukünftigen Version nicht laden...

Mal sehen, ob dies Ihnen helfen kann, und ausgehend von dem Beispiel in der Hilfe (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

Dadurch wird eine Beispieldatei geladen (die nach dem Durchlaufen des Makros nicht gespeichert werden soll) und dann wird das Makro gehalten, während es eine Fläche auswählt, dann erstellt es eine Skizze mit einem Kreis auf dieser Fläche und stanzt sie.

Herzliche Grüße

1 „Gefällt mir“
14

Ich werde Sie darüber auf dem Laufenden halten, was mir gelingen wird oder nicht.

Im Moment verbringe ich meine Abende mit Kundenprojekten, daher sind meine Verbesserungsprojekte etwas zweitrangig, aber ich verzweifle nicht, an diesem Wochenende wieder damit anzufangen. Auf jeden Fall danke ich Ihnen für die Zeit, die Sie mir widmen.

15

Hallo

Und hier ist ein Beispiel mit Auswahl auf dem aktiven Teil in SW und Prüfung, ob die Geometrie für die Extrusion das Modell kreuzt:

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

Herzliche Grüße

1 „Gefällt mir“
16

Schließlich gelang es mir, mein Problem zu lösen: Durch das Lesen Ihrer Skripte und das Durchführen von Tests verstand ich, dass ich den Namen des Körpers des ausgewählten Gesichts herausfinden musste, damit die Extrusion funktionierte.  

Das sieht also so aus: 

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

 

Vielen Dank an alle für die Hilfe.