Makro solidworks (Vba) Wybór części ze złożenia

Out of category
1

Witam

Mam makro, które z zestawu otwiera wybraną część, a następnie stosuje do niej określone przetwarzanie.

To makro działa bardzo dobrze, jeśli w złożeniu wybieram powierzchnię części do obróbki.

Z drugiej strony chciałbym dodać możliwość zastosowania tego przetwarzania poprzez wybranie części również z Menedżera funkcji (bez usuwania bieżącej możliwości z powierzchni w 3D)

Czy ktoś ma konkretny przykład lub pomysł na funkcję do użycia?

 

Poniżej znajduje się aktualny kod (oczyszczony):

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

Witam

Może coś w stylu:

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

Pozdrowienia

2 polubienia
3

Doskonale funkcjonalna odpowiedź @d.roger !

Właśnie skończyłem z powodzeniem dostosowywać go do mojego kodu.

Dziękuję.