3 Replies Latest reply on Jan 30, 2013 4:35 AM by Yong Ning

    Add the File properties to every part in the assembly without opening every part one by one

    Vincent Li

      Adding the property to every part of assembly,

       

      currently, I know the below  behavior called by API,

       

      In the assembly mode, we can open a part ,then go to file> property > add property >save part >close part , then back to the assembly, and keep on doing the same thing to next part.

       

      But it seems low performance if handle a large assmebly.

       

      and I want to do it without opening every part one by one.

       

      thanks

       

      regards

      Vincent

        • Re: Add the File properties to every part in the assembly without opening every part one by one
          Keith Rice

          Vincent,

           

          This code will add a custom property called "Test" to every part in an assembly:

           

          =========

           

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swAssy As SldWorks.AssemblyDoc

          Dim vComps As Variant

          Dim swComp As SldWorks.Component2

          Dim swCompModel As SldWorks.ModelDoc2

          Dim swCustPropMgr As SldWorks.CustomPropertyManager

          Dim i As Integer

           

          Sub main()

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

              Set swAssy = swModel

              vComps = swAssy.GetComponents(False)

              For i = 0 To UBound(vComps)

                  Set swComp = vComps(i)

                  Set swCompModel = swComp.GetModelDoc2

                  Set swCustPropMgr = swCompModel.Extension.CustomPropertyManager(Empty)

                  swCustPropMgr.Add2 "Test", swCustomInfoText, "This is a test"

                  'swCompModel.Save3 swSaveAsOptions_Silent, Empty, Empty

              Next i

          End Sub

           

          =========

           

          If you want the changes to the part to be saved, then un-comment the last line contained in the For - Next loop.

           

          Keith

          Video Tutorials for the SolidWorks API

            • Re: Add the File properties to every part in the assembly without opening every part one by one
              Yong Ning

              Thanks code.

               

              Dim SwApp As SldWorks.SldWorks
              Dim SwAss As SldWorks.AssemblyDoc
              Dim SwModel As ModelDoc2
              Sub ll()
                ''
                Dim vComps As Variant
                Dim swComp As SldWorks.Component2
                Dim swCompModel As SldWorks.ModelDoc2
                Dim swCustPropMgr As SldWorks.CustomPropertyManager
                ''
                Set SwApp = Application.SldWorks
                Set SwModel = SwApp.ActiveDoc
                Set SwAss = SwModel
                Debug.Print SwAss.GetPathName
                With SwAss
                  Debug.Print .GetComponentCount(True)
                  vComps = .GetComponents(False)
                End With
                ''
                For i = 0 To UBound(vComps)
                  Set swComp = vComps(i)
                  Set swCompModel = swComp.GetModelDoc  ' swComp.GetModelDoc2
                  Debug.Print swCompModel.GetPathName
                  tmp = cc(swCompModel)
              Next i
              With swCompModel
                
              End With
              End Sub

              Function cc(SwModel As ModelDoc2)

                  Dim vConfigNameArr                  As Variant
                  Dim vConfigName                     As Variant
                  Dim vCustInfoNameArr                As Variant
                  Dim vCustInfoName                   As Variant
                  Dim temp
                  Dim bRet                            As Boolean
                  Debug.Print "File = " & SwModel.GetPathName
                  vConfigNameArr = SwModel.GetConfigurationNames
                  ' Is empty if a drawing becasue configurations not supported on drawings
                  If IsEmpty(vConfigNameArr) Then
                      ReDim vConfigNameArr(0)
                      vConfigNameArr(0) = ""
                  Else
                      ' Add a blank string for the nonconfiguration-specific custom properties
                      ReDim Preserve vConfigNameArr(UBound(vConfigNameArr) + 1)
                  End If
                  ''
                  For Each vConfigName In vConfigNameArr
                      Debug.Print "  " & vConfigName
                      vCustInfoNameArr = SwModel.GetCustomInfoNames2(vConfigName)
                      If Not IsEmpty(vCustInfoNameArr) Then
                          For Each vCustInfoName In vCustInfoNameArr
                              Debug.Print "    " & vCustInfoName
                              Debug.Print "      Type     = " & SwModel.GetCustomInfoType3(vConfigName, vCustInfoName)
                              Debug.Print "      Value    = " & SwModel.GetCustomInfoValue(vConfigName, vCustInfoName)
                              Debug.Print "      Text     = " & SwModel.CustomInfo2(vConfigName, vCustInfoName)
                              Debug.Print vConfigName
                              'temp = SwModel.DeleteCustomInfo2(vConfigName, vCustInfoName)
                          Next
                      End If
                      Debug.Print "  ---------------------------"
                  Next
              End Function

               

              Result is

              D:\Backup\我的文档\Draw\Assem1.SLDASM
              1
              D:\Backup\我的文档\Draw\Part1.SLDPRT
              File = D:\Backup\我的文档\Draw\Part1.SLDPRT
                Default
                ---------------------------
               
                  质量
                    Type     = 30
                    Value    = 975.08
                    Text     = "SW-Mass@Part1.SLDPRT"

                ---------------------------

               

              ************************

              Dim SwApp As SldWorks.SldWorks
              Dim SwAss As SldWorks.AssemblyDoc
              Dim SwModel As ModelDoc2
              Sub ll()
                ''
                Dim vComps As Variant
                Dim swComp As SldWorks.Component2
                Dim swCompModel As SldWorks.ModelDoc2
                Dim swCustPropMgr As SldWorks.CustomPropertyManager
                ''
                Set SwApp = Application.SldWorks
                Set SwModel = SwApp.ActiveDoc
                Set SwAss = SwModel
                Debug.Print SwAss.GetPathName
                With SwAss
                  Debug.Print .GetComponentCount(True)
                  vComps = .GetComponents(False)
                End With
                ''
                For i = 0 To UBound(vComps)
                  Set swComp = vComps(i)
                  Set swCompModel = swComp.GetModelDoc  ' swComp.GetModelDoc2
                 
                  Arr = BaseCustInfo(swCompModel)
                  tmp = AddCustomInfo(swCompModel, Arr)
                  Debug.Print
              Next i
              With swCompModel
                
              End With
              End Sub


              ''

              Function AddCustomInfo(SwPart, Arr)
                '添加文件的自定义属性
                 With SwPart
                   For ii = 0 To UBound(Arr)
                         .AddCustomInfo3 "", Arr(ii, 0), 30, Arr(ii, 1)
                         .CustomInfo2("", Arr(ii, 0)) = Arr(ii, 1)
                   Next ii
                 End With
              End Function

              Function BaseCustInfo(SwModel)
                Dim FileName
                  FileName = SwModel.GetPathName
                  nn = InStrRev(FileName, "\")
                  FileName = Right(FileName, Len(FileName) - nn)
                 
               
               
                Dim Arr(3, 1)
                  Arr(0, 0) = "质量":  Arr(0, 1) = "SW-Mass":
                  Arr(1, 0) = "材料 ":  Arr(1, 1) = "SW-Material":
                  Arr(2, 0) = "密度":  Arr(2, 1) = "SW-Density":
                  Arr(3, 0) = "体积":  Arr(3, 1) = "SW-Volume":
                For ii = 0 To 3
                  Arr(ii, 1) = """" & Arr(ii, 1) & "@" & FileName & """"
                Next ii
                BaseCustInfo = Arr
               
              End Function

              Function ChangeCustomInfo(SwPart, Arr)
                '更改文件的自定义属性
                'Debug.Print SwPart.GetPathName
                 With SwPart
                   For ii = 0 To UBound(Arr)
                         .CustomInfo2("", Arr(ii, 0)) = Arr(ii, 1)
                   Next ii
                 End With
              End Function

              ''
              Function DeleteCustInfo(SwPart)
                '清空自定义属性的内容
                  Dim vConfigNameArr                  As Variant
                  Dim vConfigName                     As Variant
                  Dim vCustInfoNameArr                As Variant
                  Dim vCustInfoName                   As Variant
                  Dim bRet                            As Boolean
                 
                  With SwPart
                    vConfigNameArr = .GetConfigurationNames
                 
                    ' Is empty if a drawing becasue configurations not supported on drawings
                    If IsEmpty(vConfigNameArr) Then
                      ReDim vConfigNameArr(0)
                      vConfigNameArr(0) = ""
                    Else
                      ' Add a blank string for the nonconfiguration-specific custom properties
                      ReDim Preserve vConfigNameArr(UBound(vConfigNameArr) + 1)
                    End If
                    ''
                    For Each vConfigName In vConfigNameArr
                      vCustInfoNameArr = .GetCustomInfoNames2(vConfigName)
                      If Not IsEmpty(vCustInfoNameArr) Then
                          For Each vCustInfoName In vCustInfoNameArr
                              'Debug.Print "    " & vCustInfoName
                              bRet = SwPart.DeleteCustomInfo2(vConfigName, vCustInfoName)
                          Next
                      End If
                    Next
                  End With
              End Function

              Function BaseCustInfo(SwModel)
                Dim FileName
                  FileName = SwModel.GetPathName
                  nn = InStrRev(FileName, "\")
                  FileName = Right(FileName, Len(FileName) - nn)
                 
               
               
                Dim Arr(3, 1)
                  Arr(0, 0) = "质量":  Arr(0, 1) = "SW-Mass":
                  Arr(1, 0) = "材料 ":  Arr(1, 1) = "SW-Material":
                  Arr(2, 0) = "密度":  Arr(2, 1) = "SW-Density":
                  Arr(3, 0) = "体积":  Arr(3, 1) = "SW-Volume":
                For ii = 0 To 3
                  Arr(ii, 1) = """" & Arr(ii, 1) & "@" & FileName & """"
                Next ii
                BaseCustInfo = Arr
               
              End Function