Makro do pobierania nazwy szkicu w 1. stanie rozwiniętym

Macro
1

Witam

Chciałbym odzyskać nazwę 1. szkicu w stanie rozwiniętym, aby w razie potrzeby pokazać lub ukryć. (tutaj Składanie linii2, ale nazwa nie zawsze jest taka sama.)

456×879 50,7 KB

 

Oto kod znaleziony i działający, ale gdy znasz nazwę szkicu:

Dim swApp As Object
Dim boolstatus As Boolean
Sub main()

Set swApp = Application.SldWorks


Set Part = swApp.ActiveDoc
boolstatus = Part.ActivateView("Drawing View1")
boolstatus = Part.Extension.SelectByID2("Bend-Lines2@Part1@Drawing View1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.BlankSketch
MsgBox "Ligne de pliage caché"
boolstatus = Part.Extension.SelectByID2("Bend-Lines2@Part1@Drawing View1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.UnblankSketch
MsgBox "Ligne de pliage affiché"
End Sub

 

2

Witam.

Możesz przejść przez drzewo budowy, korzystając z następujących metod:

Funkcje (FirstFeature i GetNextFeature) 

SubFeature (GetFirstSubFeature i GetNextSubFeature)

testujemy typ według GetTypeName2

Z drugiej strony uważam, że najpierw musisz pobrać plik, który jest dołączony do widoku, otworzyć plik i przeglądać jego drzewo, ponieważ masz tylko 2 poziomy (Feature i subFeature).

Ale nigdy nie testowałem na stanie rozłożonym. Być może musisz aktywować stan rozłożony

Pozdrowienia.

1 polubienie
3

Witam. Spróbuj tego:

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swFeat = swModel.FirstFeature
    While Not swFeat Is Nothing
        'Debug.Print swFeat.Name & " " & swFeat.GetTypeName2'
        If swFeat.GetTypeName2 = "FlatPattern" Then
            Set swSubFeat = swFeat.GetFirstSubFeature
            While Not swSubFeat Is Nothing
                If swSubFeat.GetTypeName2 = "ProfileFeature" Then
                    'Debug.Print swSubFeat.GetNameForSelection(0)'
                    swSubFeat.Select2 False, 0
                    If swSubFeat.Visible = swVisibilityState_e.swVisibilityStateShown Then
                        swModel.BlankSketch
                    Else
                        swModel.UnblankSketch
                    End If
                    swModel.ClearSelection2 True
                    Exit Sub
                End If
                Set swSubFeat = swSubFeat.GetNextSubFeature
            Wend
        End If
        Set swFeat = swFeat.GetNextFeature
    Wend
End Sub

 

1 polubienie
4

Witam

Odpowiedź brzmi dobrze , JeromeP , ale nie pytanie, przepraszam.

Ujmując to inaczej, jest to kwestia wykonania tego makra przez posła do PE. Poza tym jest doskonale funkcjonalny.

Próbowałem czegoś takiego, ale  czegoś brakuje.

Dim swDraw As SldWorks.ModelDoc2       
Dim swView As SldWorks.View
Dim swFeat As SldWorks.Feature


Set swDraw = swModel
    Set swView = swDraw.GetFirstView
    Set swView = swView.GetNextView
    
    
    'Set swFeat = swModel.FirstFeature
    Set swFeat = swDraw.FirstFeature

 

5

Kod jest nieco inny w przypadku rysunku

Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swPartModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    Dim swView As SldWorks.View
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim boolstatus As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    Set swView = swDraw.ActiveDrawingView
    If swView Is Nothing Then
        MsgBox "Sélectionner une vue"
        Exit Sub
    End If

    Set swPartModel = swView.ReferencedDocument
    Set swFeat = swPartModel.FirstFeature
    While Not swFeat Is Nothing
        'Debug.Print swFeat.Name & " " & swFeat.GetTypeName2'
        If swFeat.GetTypeName2 = "FlatPattern" Then
            Set swSubFeat = swFeat.GetFirstSubFeature
            While Not swSubFeat Is Nothing
                If swSubFeat.GetTypeName2 = "ProfileFeature" Then
                    Debug.Print swSubFeat.Name & "@" & swPartModel.GetTitle & "@" & swView.GetName2
                    boolstatus = swModel.Extension.SelectByID2(swSubFeat.Name & "@" & swPartModel.GetTitle & "@" & swView.GetName2, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
                    swModel.UnblankSketch
                    
                    swModel.ClearSelection2 True
                    Exit Sub
                End If
                Set swSubFeat = swSubFeat.GetNextSubFeature
            Wend
        End If
        Set swFeat = swFeat.GetNextFeature
    Wend
End Sub

Uwaga: Powtórzenie makra nie spowoduje zmiany widoczności szkicu z jednego stanu na drugi, tak jak w przypadku poprzedniego makra. Ale odpowiada na pierwotne pytanie.

1 polubienie
6

Witam

Rzeczywiście, jest zupełnie inaczej, patrzę na to po południu, jeśli mam trochę czasu. Dziękuję.

7

Doskonale funkcjonalny, dziękuję JeromeP .

Teraz muszę go tylko dostosować w moim pełnym makro, ale nie będzie to bardzo skomplikowane.