---

Hallo Kollegen,

wie wärs mit einem Makro dass automatisch "Leiste an Ende (alles einfrieren)" ausführt?

Ist ja ein Standardbefehl der mit RMT auf die Einfrierleiste aufrufbar ist...

Grüße von der Front

PS: Ich hasse SpeedPak!!!

------------------
www.cadshop.com

http://cadshop.com/software/kingcost-dcc.html

http://www.tacton.com/

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von ramsy77:

PS: Ich hasse SpeedPak!!!

[/B]

---

Dafür gibts 10 Unities...

Mit Makro bin ich allerdings auf dem Abstellgleis, das kann ich nicht 

------------------
Rechtschreibfehler dienen nur der Belustigung des Lesenden - eine weitere Kommentierung ist nicht erwünscht!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

Hier mal ein kleines Makros.
Es druchläuft alle geöffneten Teile und setzt den FeatureFreeze-Balken ganz nach unten.

Code:

---

Dim SldWorks As Object
Dim ModelDoc As Object
Dim AktuellesDokTyp As Integer
Dim DateiMitPfad As String
Dim Dateiname As String
Dim modeldocTitle As String
Dim featurename As String
Dim boolstatus As Boolean
Dim feature As Object
Sub main()
    Set SldWorks = Application.SldWorks
    ' Featurefreeze-Balken aktivieren
    Application.SldWorks.SetUserPreferenceToggle swUserPreferenceToggle_e.swUserEnableFreezeBar, True
    Set ModelDoc = SldWorks.ActiveDoc
    ' durch alle offenen Dokumente gehen
    Set ModelDoc = SldWorks.GetFirstDocument
    While Not ModelDoc Is Nothing
    AktuellesDokTyp = ModelDoc.GetType
    Dateiname = ModelDoc.GetPathName
    ModelDoc.ForceRebuild3 True
    Select Case AktuellesDokTyp
        Case 1
            Set feature = ModelDoc.FirstFeature
            ' While we have a valid feature
            While Not feature Is Nothing
                ' Get the name of the feature
                If feature.Name = "Einfrieren***" Then
                Else
                    featurename = feature.Name
                End If
                ' Get the next feature
                Set feature = feature.GetNextFeature()
                ' Continue until the last feature is done
            Wend
            boolstatus = ModelDoc.Extension.SelectByID2(featurename, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
            boolstatus = ModelDoc.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToAfterFeature, featurename, False)
            ModelDoc.SaveAs2 Dateiname, 0, False, True
   End Select
            ' Option: Datei schließen
            modeldocTitle = ModelDoc.GetTitle
            SldWorks.CloseDoc modeldocTitle
            Set ModelDoc = SldWorks.ActiveDoc
    Wend
End Sub

---

Benutzung natürlich auf eigene Gefahr (also vorher mal Testen).

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 20. Jun. 2012 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

Hier noch eine kleine Korrektur falls es sich um Blechteile handelt:

Code:

---

Dim SldWorks As Object
Dim ModelDoc As Object
Dim AktuellesDokTyp As Integer
Dim DateiMitPfad As String
Dim Dateiname As String
Dim modeldocTitle As String
Dim featurename As String
Dim boolstatus As Boolean
Dim feature As Object
Sub main()
    Set SldWorks = Application.SldWorks
    ' Featurefreeze-Balken aktivieren
    Application.SldWorks.SetUserPreferenceToggle swUserPreferenceToggle_e.swUserEnableFreezeBar, True
    Set ModelDoc = SldWorks.ActiveDoc
    ' durch alle offenen Dokumente gehen
    Set ModelDoc = SldWorks.GetFirstDocument
    While Not ModelDoc Is Nothing
    AktuellesDokTyp = ModelDoc.GetType
    Dateiname = ModelDoc.GetPathName
    ModelDoc.ForceRebuild3 True
    Select Case AktuellesDokTyp
        Case 1
            Set feature = ModelDoc.FirstFeature
            ' While we have a valid feature
            While Not feature Is Nothing
                ' Get the name of the feature
                If feature.Name = "Einfrieren***" Then
                'ElseIf Left(feature.Name, 10) = "Abwicklung" Then
                Else
                    featurename = feature.Name
                End If
                ' Get the next feature
                Set feature = feature.GetNextFeature()
                ' Continue until the last feature is done
            Wend
            boolstatus = ModelDoc.Extension.SelectByID2(featurename, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
            boolstatus = ModelDoc.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToAfterFeature, featurename, False)
            ModelDoc.SaveAs2 Dateiname, 0, False, True
  End Select
            ' Option: Datei schließen
            modeldocTitle = ModelDoc.GetTitle
            SldWorks.CloseDoc modeldocTitle
            Set ModelDoc = SldWorks.ActiveDoc
    Wend
End Sub
               

---

Das FeatureFreeze konnte den Balken nicht hinter die Abwicklung schieben, das ist nun behoben.

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP