|
SolidWorks MakroMania ist eine Beispielsammlung einiger Makros, die Ihnen eine Vorstellung davon geben soll, was man auch schon mit Makros in SolidWorks alles anstellen kann. Der Code des Makros sollte so gut dokumentiert sein, dass Sie damit ohne weitere Anleitung verstehen, was gemacht wird. |
< voriges |
MakroMania Übersicht |
Nummer 17 Features anzeigen oder verbergen |
|
Ich übernehme keine Haftung für die korrekte Funktion der Routinen oder irgendwelcher Schäden bei der Anwendung dieser Beispiele. Das gesamte Risiko trägt der Benutzer selbst. - Sorry, muss sein.
Manchmal kann es hilfreich sein Features im Featuremanager zu verstecken, um diese vor ungewollter Änderung zu schützen. Dabei kann diese Makro helfen.
|
' ********************************************************************** |
|
In der Userform ist alles untergebracht, was für die Funktionen benötigt wird. Damit die Listbox die Checkboxes mit anzeigt steht in den Eigenschaften dazu ListStyle auf fmListStyleOption und MultiSelect auf fmMultiSelectMulti
Dazu hier der Codeteil:
Option Explicit
' predeclare 11 strings for User interface
Dim msgtext(10) As String
Const swIsHiddenInFeatureMgr = 1
Private Sub cmdCheckAll_Click()
' checks all entries in listbox to quickly hide
' all features with the next click
'
' Aktiviert alle Listboxeinträge um mit dem nächsten
' Klick schnell alle Features verbergen zu können
Dim i As Long
For i = 0 To lstFeatures.ListCount - 1
lstFeatures.Selected(i) = True
Next i
End Sub
Private Sub cmdCheckNone_Click()
' unchecks all entries in listbox to quickly show
' all features with the next click
'
' Deaktiviert alle Listboxeinträge um mit dem nächsten
' Klick schnell alle Features zeigen zu können
Dim i As Long
For i = 0 To lstFeatures.ListCount - 1
lstFeatures.Selected(i) = False
Next i
End Sub
Private Sub cmdEnd_Click()
End
End Sub
Private Sub cmdGetFeatureList_Click()
' this procedure looks for the features and their
' UIState (shown or hidden) and displays the result
' in the listbox
'
' Prozedur liest die Features und deren UIState vom
' aktiven Dokument und stellt diese in der Listbox dar.
Dim swApp As Object
Dim Part As Object
Dim Feature, subFeat As Object
Dim featureName, subFeatureName As String
Dim featcount As Long
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
' clear listbox
' Listbox leeren
lstFeatures.Clear
' get the first feature
' dann das erste Feature holen
Set Feature = Part.FirstFeature
' as long as there is another feature
' und solange noch Featuires da sind Schleife drehen
While Not Feature Is Nothing
' get the name of the feature
' den Namen des Features für die Anzeige
featureName = Feature.Name
' add this feature to the list (append to the end)
' und an die Liste anhängen
lstFeatures.AddItem featureName, featcount
' check/uncheck according to the UIstat
' den Eintrag entsprechend des UIState markieren oder eben nicht
lstFeatures.Selected(featcount) = Feature.GetUIState(swIsHiddenInFeatureMgr)
' Get the next feature
' auf zum nächsten Feature
Set Feature = Feature.GetNextFeature()
featcount = featcount + 1
Wend
' count checked entries and write it to label
' markierte Einträge zählen und eintragen
CountSelected
End Sub
Private Sub cmdSetShowHide_Click()
' this procedure sets the UIState of features according
' to the checkmarks in the listbox
' Prozedur setzt den UIState der Features gemäß der
' Markierungen in der Listbox
Dim swApp As Object
Dim Part As Object
Dim Feature, subFeat As Object
Dim featureName, subFeatureName As String
Dim featcount As Long
Dim i As Long
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
' get the first feature in the active document
' erstes Feature im aktiven Dokument holen
Set Feature = Part.FirstFeature
' as long as there is another feature
' solange noch Features zu bearbeiten sind
While Not Feature Is Nothing
' get the name of the feature
' Name des Feature holen
featureName = Feature.Name
' just a simple check: are the featurenames identical?
' als simple Fehlerprüfung: sind die Namen der Feature identisch?
If lstFeatures.List(featcount) = featureName Then
Feature.SetUIState swIsHiddenInFeatureMgr, lstFeatures.Selected(featcount)
End If
' get the next feature
' nächstes Feature bearbeioten
Set Feature = Feature.GetNextFeature()
featcount = featcount + 1
Wend
' do a rebuild to show the effects, have to use ForceRebuild, for
' EditRebuild (like recommended in API help) wont do
' um das auch zu zeigen wird ein ForceRebuild (entspricht einem
' CTRL-Q) auf oberster Ebene gemacht, da ein EditRebuild wie in der
' API Hilfe beschrieben nicht ausreicht.
Part.ForceRebuild3 (True)
End Sub
Private Sub lstFeatures_Change()
' count checked entries and write it to label
' markierte Einträge zählen und eintragen
CountSelected
End Sub
Private Sub UserForm_Initialize()
' check which language to apply. To make another language
' copy one of Subs called XyzString and make your changes
'
' Hier ausgucken welche Sprache benutzt wird. Um weitere
' Sprachen zu unterstützen unten einer der Subs kopieren
' Anpassungen machen und aufrufen
Dim swApp As Object
Set swApp = CreateObject("SldWorks.Application")
Select Case swApp.GetCurrentLanguage
Case "german"
GermanString
Case "english"
EnglishString
' Case "spanish"
' Case "french"
' Case "italian"
' Case "japanese"
Case Else
EnglishString
End Select
' on first initialisation read features of active document
' beim Aufruf Feature des aktiven Dokumentes auslesen
cmdGetFeatureList_Click
End Sub
Private Sub GermanString()
' used Strings in German
' benutzte Zeichenketten in Deutsch
UserForm1.Caption = "Zeige / Verstecke Features im FM"
lblInfo.Caption = "Anzeigen/verstecken von Features im Featuremanager. Alle Features markieren, die versteckt werden sollen"
cmdGetFeatureList.Caption = "Hole Featureliste"
cmdCheckAll.Caption = "Alle markieren"
cmdCheckNone.Caption = "Keine markieren"
cmdSetShowHide.Caption = "Zeige / Verstecke Features"
cmdEnd.Caption = "Ende"
msgtext(0) = " von "
msgtext(1) = " markiert"
End Sub
Private Sub EnglishString()
' used Strings in english
UserForm1.Caption = "Show / Hide features in featuremanager"
lblInfo.Caption = "Show / Hide features in featuremanager. Check all features which should be hidden"
cmdGetFeatureList.Caption = "Get featurelist"
cmdCheckAll.Caption = "Check all"
cmdCheckNone.Caption = "Check none"
cmdSetShowHide.Caption = "Show / hide features"
cmdEnd.Caption = "Exit"
msgtext(0) = " of "
msgtext(1) = " selected"
End Sub
Private Sub CountSelected()
' counts the selected items and fills the label
'
' zählt die markierten Einträge und schreibt das in das Label rein
Dim i As Long
Dim selcount As Long
For i = 0 To lstFeatures.ListCount - 1
If (lstFeatures.Selected(i) = True) Then
selcount = selcount + 1
End If
Next i
lblCheckCount.Caption = selcount & msgtext(0) & lstFeatures.ListCount & msgtext(1)
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |
