Clean all properties from a virtual

Hi everyone,

Currently when I tansform a child part into a virtual in an assembly, the custom properties remain identical. This causes conflicts in PDM, as some of this properties are link to variable that must remain unique.
I’m looking for a way to clean (=delete) all custom properties already existing in a file when transforming this file into a virtual. Any idea?

Hi,

Here’s my solution. It makes virtual only parts.

You can select multiple parts as well.

Option Explicit

Sub Main()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swcomp As SldWorks.Component2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swAssembly As SldWorks.AssemblyDoc

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swAssembly = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager

If swSelMgr.GetSelectedObjectCount = 0 Then

    MsgBox "Please select at least one component.", vbOKOnly + vbInformation
    End
End If

Dim i As Integer
Dim ParentComponent As SldWorks.Component2
Dim SelectedComponentsID() As Variant

ReDim SelectedComponentsID(swSelMgr.GetSelectedObjectCount - 1)

For i = 1 To swSelMgr.GetSelectedObjectCount
    
    Set swcomp = swSelMgr.GetSelectedObjectsComponent2(i)
    Set ParentComponent = swcomp.GetParent
    
    If (swcomp.GetModelDoc2().GetType = swDocumentTypes_e.swDocPART) And (ParentComponent Is Nothing) Then
    
        SelectedComponentsID(i - 1) = swcomp.GetID
    Else
    
        MsgBox "You have selected an assembly document type or a child part: " & GetComponentName(swcomp.GetPathName), vbOKOnly + vbInformation
    End If
Next

For i = 1 To swSelMgr.GetSelectedObjectCount
    
    If (swcomp.MakeVirtual) = 1 Then
        
        Set swcomp = swAssembly.GetComponentByID(SelectedComponentsID(i - 1))
        
        Dim RefModel As SldWorks.ModelDoc2
        Dim RefConfigMgr As SldWorks.ConfigurationManager
        Dim RefConfig As SldWorks.Configuration
        
        Set RefModel = swcomp.GetModelDoc2
        
        Dim ConfigNames As Variant
        ConfigNames = RefModel.GetConfigurationNames
        
        ReDim Preserve ConfigNames(UBound(ConfigNames) + 1)
        
        Dim RefCustomPropMgr As SldWorks.CustomPropertyManager
        Dim j As Integer
        
        For j = 0 To UBound(ConfigNames)
            
            Set RefCustomPropMgr = RefModel.Extension.CustomPropertyManager(ConfigNames(j))
            
            Dim PropertyNames As Variant
            RefCustomPropMgr.GetAll PropertyNames, Nothing, Nothing
            
            Dim h As Integer
            
            For h = 0 To UBound(PropertyNames)
            
                RefCustomPropMgr.Delete PropertyNames(h)
            Next
        Next
        
        RefModel.Save2 True
    Else
    
        MsgBox "Making virtual component " & GetComponentName(swcomp.GetPathName) & " was not possible!", vbOKOnly + vbExclamation
    End If
Next
End Sub

Private Function GetComponentName(ByVal RefComponent As Variant) As String

RefComponent = Split(RefComponent, "\")
GetComponentName = RefComponent(UBound(RefComponent))
End Function
2 Likes

Thanks for this code, I’ll try it.
However I already see that it doesn’t work on a virtual assembly which is one of my main issue today :frowning: (I have to go through and open each sub-assy and re-run the macro.)

I managed to get the following code on another forum, which goes through all child of the current model. It works on a child virtual assembly but no on the child of this sub-assembly. I didn’t manage to get an iterative run of the code within the code :stuck_out_tongue:

Option Explicit
Dim swApp           As SldWorks.SldWorks
Dim doc             As SldWorks.ModelDoc2
Dim swModel         As SldWorks.ModelDoc2
Dim asm             As SldWorks.AssemblyDoc
Dim compDoc         As SldWorks.ModelDoc2
Dim swModelDocExt   As ModelDocExtension
Dim swCustProp      As CustomPropertyManager
Dim swConfig        As SldWorks.Configuration
Dim swConfMgr       As SldWorks.ConfigurationManager
Dim comp            As SldWorks.Component2

Dim components      As Variant
Dim vComp           As Variant
Dim pathChain       As Variant
Dim titleChain      As Variant
Dim vPath           As Variant
Dim vConfigNameArr  As Variant
Dim vConfigName     As Variant
Dim vPropNames      As Variant
Dim vPropTypes      As Variant
Dim vPropValues     As Variant
Dim resolved        As Variant
Dim linkProp        As Variant

Dim nDocType        As Long
Dim nErrors         As Long
Dim nWarnings       As Long
Dim nNbrProps       As Long
Dim lRetVal         As Long
Dim j               As Long
Dim i               As Long

Dim bResult3        As Boolean
Dim boolstatus      As Boolean
Dim wasResolved     As Boolean
Dim linkToProp      As Boolean

Dim ValOut          As String
Dim ResolvedValOut  As String
Dim sCustProp       As String
Dim sConfig         As String
Sub main()

    Set swApp = Application.SldWorks
    Set doc = swApp.ActiveDoc
    If doc Is Nothing Then Exit Sub
    If doc.GetType <> swDocASSEMBLY Then Exit Sub
    Set asm = doc
    components = asm.GetComponents(False)   ' Get all components
    
    If IsArray(components) Then
        For Each vComp In components
            Set comp = vComp
            Set compDoc = comp.GetModelDoc2
            If Not compDoc Is Nothing Then
                bResult3 = compDoc.Extension.IsVirtualComponent3(pathChain, titleChain)
                If bResult3 <> False Then
                    For Each vPath In pathChain
                        If vPath <> doc.GetPathName Then
                            If InStr(LCase(vPath), "sldprt") > 0 Then
                                nDocType = swDocPART
                            ElseIf InStr(LCase(vPath), "sldasm") > 0 Then
                                nDocType = swDocASSEMBLY
                            ElseIf InStr(LCase(vPath), "slddrw") > 0 Then
                                nDocType = swDocDRAWING
                            Else
                                ' Probably not a SOLIDWORKS file
                                nDocType = swDocNONE
                                ' So cannot open the file
                                Exit Sub
                            End If
                        Set swModel = swApp.OpenDoc6(vPath, nDocType, swOpenDocOptions_Silent, "", nErrors, nWarnings)
                        Set swModelDocExt = swModel.Extension
                        Set swCustProp = swModelDocExt.CustomPropertyManager("")
                        nNbrProps = swCustProp.Count
                        lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
                        For j = 0 To nNbrProps - 1
                            For i = 0 To UBound(vPropNames)
                                sCustProp = vPropNames(i)
                                boolstatus = swModel.DeleteCustomInfo2("", sCustProp)
                            Next i
                        Next j
                        Set swConfMgr = swModel.ConfigurationManager
                        Set swConfig = swConfMgr.ActiveConfiguration
                        vConfigNameArr = swModel.GetConfigurationNames
                        For Each vConfigName In vConfigNameArr
                            Set swCustProp = swModelDocExt.CustomPropertyManager(vConfigName)
                            nNbrProps = swCustProp.Count
                            lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
                            For j = 0 To nNbrProps - 1
                                sConfig = vConfigName
                                For i = 0 To UBound(vPropNames)
                                    sCustProp = vPropNames(i)
                                    boolstatus = swModel.DeleteCustomInfo2(sConfig, sCustProp)
                                Next i

                            Next j
                        Next
                    End If
                    Next
                End If
            End If
        Next
    End If
End Sub

Nice.

I didn’t follow you about making virtual component by selecting an assembly component and traversing every children components for manking them virtual too.

Reading the code that you got I see the code just clear the custom properties for the detected virtual components.

My code will:

  1. Get the components ID from selected components
  2. Make them virtual
  3. Clear the custom properties for every previously selected component

So, if you make a mistake the original file will remain unmodified.