Ich habe einen Raum, der viele Farbkonfigurationen hat.
Im Baum befindet sich eine grundlegende Skizze zum Erstellen der Funktionen.
Die Skizze ist in allen Konfigurationen sichtbar.
Ich würde gerne wissen, ob jemand eine Lösung hat, um diesen Sketch in allen Konfigurationen gleichzeitig auszublenden?
Denn wenn man sich die Eigenschaften des Sketches anschaut, kann man "gelöscht" ankreuzen und hat die Konfigurationsoption. Aber es gibt nichts zu verbergen...
Hallo, schauen Sie sich dieses Makro an, das aus dem Gedächtnis die Arbeit erledigt. (blendet alle Sketche aller Konfigurationen aus)
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim curFeature As Feature
Dim subFeature As Feature
Dim featureTypeName As String
Dim firstSub As Boolean
Dim Msg As String
Dim Style As Variant
Dim cfgNames As Variant
Dim cfg As Variant
Dim Title As String
Dim originalCfg As String
Dim lastCfg As String
Dim modView As ModelView
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> swDocPART Then
Msg = "Only Allowed on Part" ' Define message
Style = vbOKOnly ' OK Button only
Title = "Error" ' Define title
Call MsgBox(Msg, Style, Title) ' Display error message
Exit Sub ' Exit this program
End If
cfgNames = swModel.GetConfigurationNames
originalCfg = swModel.GetActiveConfiguration.Name
Debug.Print "Original Cfg:" & originalCfg
For Each cfg In cfgNames
swModel.ShowConfiguration2 cfg
HideGeom swModel
lastCfg = cfg
Debug.Print "Last Cfg:" & lastCfg
Next
If Not lastCfg = originalCfg Then
swModel.ShowConfiguration2 originalCfg
End If
Set modView = swModel.ActiveView
modView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges
modView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_PerspectiveOff
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayAmbientOcclusionShadows, False
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayShadowsInShadedMode, False
swModel.Extension.ViewDisplayRealView = False
swModel.ShowNamedView2 "", swStandardViews_e.swIsometricView
swModel.ViewZoomtofit2
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swPerformanceVerifyOnRebuild, True
End Sub
Sub HideGeom(m As ModelDoc2)
Set curFeature = m.FirstFeature()
Do While Not curFeature Is Nothing
featureTypeName = curFeature.GetTypeName2()
If curFeature.Visible = swVisibilityState_e.swVisibilityStateShown And Not curFeature.IsSuppressed Then
Select Case featureTypeName
Case "RefPlane", "RefAxis", "CoordSys", "RefPoint", "ReferenceCurve"
Debug.Print "FeatureTypeName: " & curFeature.Name & " " & featureTypeName
curFeature.Select (False)
m.BlankRefGeom
Case "ProfileFeature", "3DProfileFeature"
Debug.Print "FeatureTypeName: " & curFeature.Name & " " & featureTypeName
curFeature.Select (False)
m.BlankSketch
End Select
End If
firstSub = True
Set subFeature = curFeature.GetFirstSubFeature()
Do While Not subFeature Is Nothing
featureTypeName = subFeature.GetTypeName2()
If subFeature.Visible = swVisibilityState_e.swVisibilityStateShown And Not subFeature.IsSuppressed Then
Select Case featureTypeName
Case "RefPlane", "RefAxis", "CoordSys", "RefPoint", "ReferenceCurve"
If firstSub Then
Debug.Print "FeatureTypeName: " & subFeature.Name & " " & featureTypeName
firstSub = False
End If
Debug.Print vbTab & "FeatureTypeName: " & subFeature.Name & " " & featureTypeName
curFeature.Select (False)
m.BlankRefGeom
Case "ProfileFeature", "3DProfileFeature"
If firstSub Then
Debug.Print "FeatureTypeName: " & subFeature.Name & " " & featureTypeName
firstSub = False
End If
Debug.Print vbTab & "FeatureTypeName: " & subFeature.Name & " " & featureTypeName
curFeature.Select (False)
m.BlankSketch
End Select
End If
Set subFeature = subFeature.GetNextSubFeature()
Loop
Set curFeature = curFeature.GetNextFeature()
Loop
End Sub