Macro om de schetsnaam op te halen in de 1e uitgevouwen staat

Macro
1

Hallo

Ik wil graag de naam van de 1e schets in uitgevouwen staat herstellen om deze naar behoefte te tonen of te verbergen. (hier Folding line2 maar de naam is niet altijd hetzelfde.)

456×879 50,7 KB

 

Hier is de code gevonden en werkend, maar als je de naam van de schets weet:

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

Hallo.

U kunt de bouwboom doorlopen op de volgende manieren:

Functies (FirstFeature en GetNextFeature) 

SubFeature (GetFirstSubFeature en GetNextSubFeature)

we testen het type op GetTypeName2

Aan de andere kant denk ik dat je eerst het bestand moet ophalen dat aan de weergave is gekoppeld, het bestand moet openen en door de boom moet bladeren, omdat je maar 2 niveaus hebt (Feature en subFeature).

Maar ik heb nog nooit getest op een uitgevouwen toestand. Misschien moet u de uitgevouwen toestand activeren

Vriendelijke groeten.

1 like
3

Hallo. Probeer het volgende:

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 like
4

Hallo

Het antwoord is goed JeromeP, maar niet de vraag sorry.

Om het anders te formuleren, het is een kwestie van deze macro doen van een Europarlementariër. Voor de rest is het perfect functioneel.

Ik heb zoiets geprobeerd, maar  er ontbreekt iets.

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

De code is een beetje anders voor een tekening

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

Opmerking: Als u de macro herhaalt, verandert de zichtbaarheid van de schets niet van de ene status naar de andere, zoals bij de vorige macro. Maar het beantwoordt de oorspronkelijke vraag.

1 like
6

Hallo

Het is inderdaad heel anders, ik kijk er 's middags naar als ik een beetje tijd heb. Bedankt.

7

Perfect functioneel, bedankt JeromeP .

Nu moet ik het alleen nog aanpassen in mijn volledige macro, maar het zal niet erg ingewikkeld zijn.