Makro Solidworks (Vba) Teileauswahl aus einer Baugruppe

Out of category
1

Hallo

Ich habe ein Makro, das aus einer Baugruppe das ausgewählte Teil öffnet und dann eine bestimmte Verarbeitung darauf anwendet.

Dieses Makro funktioniert sehr gut, wenn ich in der Baugruppe eine Fläche des zu bearbeitenden Teils auswähle.

Auf der anderen Seite möchte ich die Möglichkeit hinzufügen, diese Verarbeitung anzuwenden, indem ich das Teil auch aus dem Feature-Manager auswähle (ohne die aktuelle Möglichkeit von einer Fläche in der 3D zu entfernen)

Hat jemand ein konkretes Beispiel oder eine Idee für die zu verwendende Funktion?

 

Nachfolgend finden Sie den aktuellen Code (bereinigt):

Sub main()

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

                Dim swSelMgr As SldWorks.SelectionMgr
                Dim swCompEnt As SldWorks.Entity
                Dim swPartFeat As SldWorks.Feature
                Dim swCompModel As SldWorks.ModelDoc2
                Dim swPartEnt As SldWorks.Entity
                Dim swConfigMgr As SldWorks.ConfigurationManager
                Dim swModelDocExt As SldWorks.ModelDocExtension
                Dim nRetval As Long
                Set swSelMgr = swModel.SelectionManager
                Dim CurSelCount As Long
                CurSelCount = swSelMgr.GetSelectedObjectCount
                Set swCompEnt = swSelMgr.GetSelectedObject6(1, 0)
                Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, 0)
                Set swCompModel = swComp.GetModelDoc
                Set swConfigMgr = swCompModel.ConfigurationManager
                Set swCompModelConfig = swConfigMgr.ActiveConfiguration
                Set swModelDocExt = swCompModel.Extension
                Set swPartEnt = swModelDocExt.GetCorrespondingEntity(swCompEnt)
                Set swCompModel = swApp.ActivateDoc2(swCompModel.GetPathName, True, nRetval): Debug.Assert 0 = nRetval
                Dim swConfig As SldWorks.Configuration
                Set swModel = swApp.ActiveDoc
                swModel.ShowConfiguration2 (swComp.ReferencedConfiguration)
                Debug.Print "File = " + swModel.GetPathName
                Debug.Print "  Component       = " + swComp.Name2 + " <" + swComp.ReferencedConfiguration + ">" + " [" + swComp.GetPathName + "]"
                Debug.Print "  Model           = " + swCompModel.GetPathName + " <" + swCompModelConfig.Name + ">"
End Sub

 

2

Hallo

So etwas wie das Folgende:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim CompModel As ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim SelectedObject As Object
Dim NbrSelections As Long
Dim i As Long

Sub main()

    Set swApp = Application.SldWorks
    Set Model = swApp.ActiveDoc

    Dim SelMgr As SelectionMgr
    Set SelMgr = Model.SelectionManager
        
    NbrSelections = SelMgr.GetSelectedObjectCount2(-1)
        
    For i = 1 To NbrSelections
        Set SelectedObject = SelMgr.GetSelectedObject6(i, -1)
        Debug.Print "Type object : " & SelMgr.GetSelectedObjectType3(i, -1)
        If SelMgr.GetSelectedObjectType3(i, -1) = 20 Then
            Set swChildComp = SelectedObject
            Set CompModel = swChildComp.GetModelDoc2
            
            Debug.Print "1 - Nom : " & swChildComp.Name
            Debug.Print "1 - Chemin : " & CompModel.GetPathName
            Debug.Print "1 - Titre : " & CompModel.GetTitle
        ElseIf SelMgr.GetSelectedObjectType3(i, -1) = 2 Then
            Set swChildComp = SelMgr.GetSelectedObjectsComponent3(1, 0)
            Set CompModel = swChildComp.GetModelDoc2
            
            Debug.Print "2 - Nom : " & swChildComp.Name
            Debug.Print "2 - Chemin : " & CompModel.GetPathName
            Debug.Print "2 - Titre : " & CompModel.GetTitle
        End If
    Next i
    
End Sub

Herzliche Grüße

2 „Gefällt mir“
3

Perfekt funktionale Antwort @d.roger !

Ich habe es gerade erfolgreich an meinen Code angepasst.

Vielen Dank.