6 Replies Latest reply on Oct 3, 2017 9:02 PM by Solid Air

    [Help needed] Macro to add specific text to remarks column in excel list of components

    Roy Chua

      Here's a little background to what I have.

       

      I currently have a macro to list in all components of an assembly in an excel sheet.

      I will run the macro on the assembly, it will open excel and begin listing every components, thereafter it will reorder that list alphabetically.

      The columns of the excel sheet are based on each component's custom property (set using a separate macro).

      In general, most components have a blank "Remarks" column.

      For certain components, I will put them in a Assembly Tree Folder named "KIT"

       

      I need a code that I can add on to my macro, such that it can "detect" if certain components are in that "KIT" folder and add the word "KIT" to the remark column.

       

      The problem I have is that I cannot just simply add the word "KIT" to the component's "Remarks" custom property, as these components when used in other assemblies are not "KIT" items, and I don't want them to have the "KIT" in remarks when I run my macro for other assemblies.

        • Re: [Help needed] Macro to add specific text to remarks column in excel list of components
          Solid Air

          In API help there is an example of how to find features in a folder: Get Contents of FeatureFolder Example (VBA).

           

          (To get the component object of feature under the folder use Feature::GetSpecificFeature2)

           

          Hope this helps.

          • Re: [Help needed] Macro to add specific text to remarks column in excel list of components
            Roy Chua

            For sharing,

             

            I have managed to get it to work with the following code below.

            In short, I used the code to compile a line of Part numbers and stored it in a 2nd sheet Cell "A1".

             

            Private Function KITLIST()
                 Dim swFeatMgr                   As SldWorks.FeatureManager
                 Dim swFeat                      As SldWorks.Feature
                 Dim swFeatFolder                As SldWorks.FeatureFolder
                 Dim swFtrFolder                 As SldWorks.Feature
                 Dim FeatType                    As String
                 Dim FeatTypeName                As String
                 Dim NbrOfFeatures               As Long
               

                Dim Features                    As Variant
                 Dim i                           As Long
                    
               
                Dim featureArr(2) As SldWorks.Feature
                 Dim featureObj As Variant
                
                 Set swFeatMgr = swModel.FeatureManager
                 Set xlsheet = xlBook.Worksheets("Sheet2")
                
                 xlCurRow = 1

                Set swFeat = swModel.FirstFeature
                 Do While Not swFeat Is Nothing
                     FeatType = swFeat.Name
                     FeatTypeName = swFeat.GetTypeName2
                     Dim temp As Long
                     temp = InStr(1, FeatType, "EndTag", vbTextCompare)
                    

                    If (FeatTypeName = "FtrFolder" And temp = 0 And FeatType = "KIT") Then
                         Set swFeatFolder = swFeat.GetSpecificFeature2
                         Features = swFeatFolder.GetFeatures
                         For i = 0 To (swFeatFolder.GetFeatureCount - 1)
                              Set swFtrFolder = Features(i)
                              xlsheet.Range("A" & xlCurRow).Value = swFtrFolder.Name & " , " & xlsheet.Range("A" & xlCurRow).Value
                         Next i
                     End If
                    
                     Set swFeat = swFeat.GetNextFeature
                 Loop
                   Set xlsheet = xlBook.Worksheets("Sheet1")
                   xlCurRow = 11

            End Function

             

             

            Then in my main code, I used the following to check if the part number in my main can be found in list in Sheet 2.

            After which, I would have the "KIT" in my remarks column and also a "KIT" added to the part number

             

                        Dim CheckKIT As Integer

             

                        CheckKIT = InStr(1, xlBook.Worksheets("Sheet2").Range("A1"), swComp.Name, vbTextCompare)

             

                        If CheckKIT > 0 Then

                        xlsheet.Range("D" & xlCurRow).Value = xlsheet.Range("D" & xlCurRow).Value & " KIT"

                        xlsheet.Range("K" & xlCurRow).Value = "KIT " & xlsheet.Range("K" & xlCurRow).Value

                        End If

             

                        xlsheet.Range("D" & xlCurRow).Value = xlsheet.Range("D" & xlCurRow).Value

                        xlsheet.Range("K" & xlCurRow).Value = xlsheet.Range("K" & xlCurRow).Value

                       

                        xlCurRow = xlCurRow + 1

             

            After my main code finishes listing every component in my main assembly, I would then delete the "KIT" from the part numbers with the following.

             

                Dim LastRow5 As Long

                LastRow5 = Range("D" & Rows.Count).End(xlUp).Row

                xlCurRow = 11

                For xlCurRow = 11 To LastRow5

                xlsheet.Range("D" & xlCurRow).Value = Left(xlsheet.Range("D" & xlCurRow).Value, InStr(xlsheet.Range("D" & xlCurRow).Value, " K") - 1)

                Next xlCurRow

             

            Hope I made sense with what I have above.