Code:
' Rebuild and Freeze Part in Assy (SW2014).swp ---------------------------------02/04/15
' Description: Macro to rebuild all parts and Freeze in active assembly.
' Precondition: An active assembly containing part Files.
' Postcondition: All part files in the active assembly will be force rebuild and freezed.
' Please back up your data before use and USE AT OWN RISK
'
' This macro is provided as is. No claims, support, refund, safety net, or
' warranties are expressed or implied. By using this macro and/or its code in
' any way whatsoever, the user and any entities which the user represents,
' agree to hold the authors free of any and all liability. Free distribution
' and use of this code in other free works is welcome. If any portion of
' this code is used in other works, credit to the authors must be placed in
' that work within a user viewable location (e.g., macro header). All other
' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
' without the expressed written consent by the authors. Use at your own risk!
' ------------------------------------------------------------------------------
' Written by: Deepak Gupta (http://gupta9665.wordpress.com/)
' -----------------------------------------------------------------------------
' https://forum.solidworks.com/message/482618#comment-482618
' modified by CK 11.01.2018Option Explicit
' set to 1 moves the freeze bar to the end, set to 4 moves it to the top (unfreeze)
Const FREEZE As Integer = 4
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
Dim swChildComp As SldWorks.Component2
Dim swPart As SldWorks.ModelDoc2
Dim swChildModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swCompConfig As SldWorks.Configuration
Dim vChildComp As Variant
Dim sPadStr As String
Dim i As Long
Dim Errors As Long
For i = 0 To nLevel - 1
sPadStr = sPadStr + " "
Next i
' resolve all LightWeight components
Set swChildModel = swComp.GetModelDoc
Set swAssy = swModel
swAssy.ResolveAllLightWeightComponents (True)
Set swChildModel = Nothing
vChildComp = swComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
Set swChildModel = swChildComp.GetModelDoc
If Not swChildModel Is Nothing Then
If swChildModel.GetType = 2 Then
Debug.Print nLevel & " - " & swChildComp.GetPathName
TraverseComponent swChildComp, nLevel + 1
Else
Set swPart = swApp.ActivateDoc3(swChildComp.GetPathName, False, swDontRebuildActiveDoc, Errors)
If swPart.IsOpenedReadOnly = False Then
Debug.Print nLevel & " - " & swPart.GetPathName
'swPart.FeatureManager.EditFreeze 4, "", True ' Freeze bar to Top
'swPart.ForceRebuild3 (False)
swPart.FeatureManager.EditFreeze FREEZE, "", True ' Freeze bar to End if FREEZE is set to 1
swModel.ShowNamedView2 "*Isometric", -1
swModel.ViewZoomtofit2
swPart.Save
Else
Debug.Print nLevel & " - " & swChildComp.GetPathName & " (READONLY)"
End If
swApp.CloseDoc swPart.GetTitle
End If
Else
Debug.Print nLevel & " - " & swChildComp.GetPathName & " (skipped)"
End If
Next i
End Sub
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
Debug.Print "---START---"
TraverseComponent swRootComp, 1
Debug.Print "---END---"
'swModel.ForceRebuild3 (False)
'swModel.ShowNamedView2 "*Isometric", -1
'swModel.ViewZoomtofit2
'swModel.Save
End Sub
Foren auf CAD.de (alle Foren)
| 
