VBA - Zuweisen einer Variablen zu einer manuellen Auswahl

ixxs71 · 24. September 2021 um 10:19

Hallo

Aus einer Auswahl wie diesem 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

Ist es möglich, das Ergebnis des Zeigens in einer Variablen zu platzieren, anstatt erneut eine Auswahl zu treffen, um auf dieselbe Fläche zu zeigen? Und wie rufen Sie diese Auswahl auf, um den neuen Vorgang auszuführen?

Ich hoffe, ich habe mich klar genug ausgedrückt...

d.roger · 24. September 2021 um 11:33

Hallo

"Ist es möglich, das Ergebnis des Zeigens in eine Variable zu setzen?": Das ist bereits, was Sie tun, da Sie Ihre Auswahl in der Variablen swEnt speichern, so lange Ihr Makro läuft, setzen Sie diese Variable nicht zurück oder weisen ihr einen neuen Wert zu ...

Herzliche Grüße

ixxs71 · 24. September 2021 um 12:53

Ja, ich bin mit dem Prinzip einverstanden, aber wie zeige ich danach auf diese Variable? (siehe Kommentar am Ende des Codes)


 

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

Maclane · 24. September 2021 um 13:38

Hallo;

Ein Hinweis = https://help.solidworks.com/SOLIDWORKS.Interop.sldworks~SOLIDWORKS.Interop.sldworks.IFeatureManager~InsertRefPlane.html
mit

. InsertRefPlane(FirstConstraint, FirstConstraintAngleOrDistance_
, SecondConstraint, SecondConstraintAngleOrDistance, ThirdConstraint, ThirdConstraintAngleOrDistance)
und

Vor dem Aufrufen dieser Methode müssen Sie die Referenzentitäten mit diesen Markierungen mit IModelDocExtension::SelectByID2 ausgewählt haben:

0 = Erste Referenzeinheit
1 = Zweite Referenzeinheit
2 = Dritte Referenzeinheit

Herzliche Grüße

ixxs71 · 24. September 2021 um 13:59

Wenn ich deinen Hinweis verstehe, muss ich das tun

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

Was platziere ich anstelle von ????

JeromeP · 24. September 2021 um 17:55

Hallo

Um die Fläche auszuwählen, können Sie Folgendes verwenden:

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

Maclane · 27. September 2021 um 06:28

Hallo;

Die Funktion "InsertRefPlane" übernimmt automatisch die vorherigen Auswahlen in der richtigen Reihenfolge.
Außer der Bequemlichkeit ist es nicht notwendig, sie zu benennen. Sie müssen "InsertRefPlane" nur mitteilen, was Sie damit machen möchten:

Zum Beispiel: das Makro unten

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

Äquivalent zu:
Erstellung einer neuen Ebene: Übereinstimmung (4) und (0) mit meiner ersten Auswahl (Ref1) mit einem Winkel von 80° (16) und (1.39626340159547) mit meiner zweiten Auswahl...
In Ihrem Fall InsertRefPlane(32,0,2,0,0,0) = tangential zur ersten Auswahl und dann senkrecht zur zweiten Auswahl.

Die Werte, die die Art der Abhängigkeiten bestimmen, sind hier aufgeführt help.solidworks.com

swRefPlaneReferenceConstraint_Angle	16 oder 0x10
swRefPlaneReferenceConstraint_Coincident	4 oder 0x4
swRefPlaneReferenceConstraint_Distance	8 oder 0x8
swRefPlaneReferenceConstraint_MidPlane	128 oder 0x80
swRefPlaneReferenceConstraint_OptionFlip	256 oder 0x100
swRefPlaneReferenceConstraint_OptionOriginOnCurve	512 oder 0x200
swRefPlaneReferenceConstraint_OptionProjectAlongSketchNormal	2056 oder 0x800
swRefPlaneReferenceConstraint_OptionProjectToNearestLocation	1028 oder 0x400
swRefPlaneReferenceConstraint_OptionReferenceFlip	8192 Gold 0x2000
swRefPlaneReferenceConstraint_Parallel	1 oder 0x1
swRefPlaneReferenceConstraint_ParallelToScreen	4096 oder 0x1000
swRefPlaneReferenceConstraint_Perpendicular	2 oder 0x2
swRefPlaneReferenceConstraint_Project	64 oder 0x40
swRefPlaneReferenceConstraint_Tangent	32 oder 0x20

Herzliche Grüße

ixxs71 · 27. September 2021 um 07:04

@Maclane @JeromeP

Vielen Dank für Ihre Antworten, ich werde es mir heute Abend ansehen. Ich hatte ein arbeitsreiches Wochenende, um wieder in meine Entwicklung einzutauchen. Ich halte euch trotzdem auf dem Laufenden

d.roger · 29. September 2021 um 11:36

Hallo

Da swEnt ein Gesicht ist, können Sie es mit der IsSame-Funktion in dem Moment abrufen, in dem Sie es benötigen. Seien Sie vorsichtig, das 3D-Modell darf vor dem Aufruf dieser Funktion nicht neu erstellt werden, da es sonst nicht funktioniert (bevorzugen Sie ggf. die Verwendung von swModel.GraphicsRedraw2).

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

Eine andere Lösung wäre, dieses Gesicht zu benennen:

    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)

Suchen Sie dann bei Bedarf anhand des kleinen Namens danach.

    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

Herzliche Grüße

d.roger · 29. September 2021 um 11:50

Was zum Beispiel dies auf dem Anhang geben kann:

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

ixxs71 · 29. September 2021 um 12:01

@d.Roger Respekt!

Ich laufe tagsüber mit meinem neuen unbefristeten Vertrag und abends mit meinen ehemaligen Kunden, die mich nicht loslassen (ich beschwere mich nicht, eh) und Sie geben mir eine ganze Entwicklung meines Problems!

Ich werde mir wirklich Zeit nehmen müssen, um mir das anzuschauen, zumindest um Ihre Arbeit zu würdigen und damit auch all jene, die mit ihren Antworten den schmilblick voranbringen!