7 Replies Latest reply on Jan 23, 2014 1:33 PM by Matt Martens

    How can i get my selection set to work with CreateSaveBodyFeature in a part ?

    Marquis Leblanc

      Hi Deepak,  and all the McFadden, Lamport, Schroeder, Tiffany, and others ...

       

      I need your help to get a CreateSaveBodyFeature to work properly.

       

      I already have a macro in VBA that works fine, to rename the bodies in a weldment part cut-list

      and that selects the desired bodies ( all unique bodies )  ( not all bodies )

       

      I already got a look at the  Create Save Bodies Feature and Create an Assembly (VBA) exemple

       

      and tried using parts of it, and tweak, and so on ....

       

      but i can't get to pass my "selection set" to the CreateSaveBodyFeature

       

      my " selection set "  is built along the macro by using

       

      retval = swModExt.SelectByID2(cutlistfolderbodies(i - 1).GetSelectionId, "SOLIDBODY", 0#, 0#, 0#, True, 0, Nothing, swSelectOptionDefault)

       

      ... so far , everything is fine , i have what i need selected ...

       

      but i don't know how to push that " selection set " to

       

      retval = swFeatMgr.CreateSaveBodyFeature(BodiesToSave, fileNameVar, AssyName, False, False)

       

      so far , all i tried failed.

       

      Can someone help me understand that feature command ?

       

      thanks in advance

       

      included bellow, is what i have so far ,  including many trials and errors that

      i commented out ....

       

      the line of interest is far down at the end,   the 4th line from the end

       

       

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

       

      'Dim swApp As Object

      Public Enum swDocumentTypes_e
          swDocNONE = 0       '  Used to be TYPE_NONE
          swDocPART = 1       '  Used to be TYPE_PART
          swDocASSEMBLY = 2   '  Used to be TYPE_ASSEMBLY
          swDocDRAWING = 3    '  Used to be TYPE_DRAWING
      End Enum

      Public Enum swBodyType_e
          swSolidBody = 0
          swSheetBody = 1
          swWireBody = 2
          swMinimumBody = 3
          swGeneralBody = 4
          swEmptyBody = 5
      End Enum


      Sub main()

      Dim swApp       As SldWorks.SldWorks
      Set swApp = Application.SldWorks

      Dim swModel     As SldWorks.ModelDoc2
      Set swModel = swApp.ActiveDoc

      Dim swModExt    As SldWorks.ModelDocExtension
      Set swModExt = swModel.Extension

      Dim swSelMgr    As SldWorks.SelectionMgr
      Set swSelMgr = swModel.SelectionManager

      Dim iswSelMgr As SldWorks.ISelectionMgr
      Set iswSelMgr = swModel.ISelectionManager

      Dim thisFeat    As SldWorks.Feature
      Dim thisSubFeat As SldWorks.Feature
      Dim custPropMgr As SldWorks.CustomPropertyManager
      Dim swFeatMgr   As SldWorks.FeatureManager

      Dim retValue As Integer

      Dim AssyName As String
      Dim Pathname As String
      Dim Prefixe  As String
      Dim Acronyme As String
      Dim Sufixe   As String

      Dim fileNames(1) As String
      Dim fileNameVar  As Variant

      Dim BodiesToSave As Variant

      Dim retDescription  As String
      Dim retDescription1 As String
      Dim retLength       As String
      Dim retLength1      As String
      Dim retWidth        As String
      Dim retWidth1       As String
      Dim retASS_CODEPRODUIT  As String
      Dim retASS_CODEPRODUIT1 As String
      Dim retSheet        As String
      Dim retSheet1       As String
      Dim nameS           As Variant
      Dim cutListFolder   As SldWorks.BodyFolder

      Dim boolstatus As Boolean
      Dim value As Integer

      Dim i As Integer
      Dim j As Integer
      j = 0

      Sufixe = "a"
      Acronyme = "0"

      Select Case swModel.GetType  ' Document type verification
              Case swDocNONE
                 value = swApp.SendMsgToUser2("No Document Active, Use this macro in a Weldment Part", swMbWarning, swMbOk)
                 Exit Sub
              Case swDocPART
              Case swDocASSEMBLY
                 value = swApp.SendMsgToUser2("The Active Document is an Assembly, Use this macro in a Weldment Part", swMbWarning, swMbOk)
                 Exit Sub
              Case swDocDRAWING
                 value = swApp.SendMsgToUser2("The Active Document is a Drawing, Use this macro in a Weldment Part", swMbWarning, swMbOk)
                 Exit Sub
              Case Else
                 Exit Sub
      End Select

      swModel.ClearSelection2 True

      Debug.Print "Part name = " & swModel.GetTitle
      Debug.Print "complete Part name = " & swModel.GetPathName
      'Debug.Print Left(swModel.GetTitle, (InStr(swModel.GetTitle, ".") - 1))
      Debug.Print "Path name = " & Left(swModel.GetPathName, (InStr(swModel.GetPathName, swModel.GetTitle) - 1))
      Pathname = Left(swModel.GetPathName, (InStr(swModel.GetPathName, swModel.GetTitle) - 1))
      Debug.Print "bodies sufix = " & Left(swModel.GetTitle, (InStr(1, swModel.GetTitle, "ems", 1) - 2))
      AssyName = Left(swModel.GetTitle, (InStr(1, swModel.GetTitle, ".", 1) - 1))
      AssyName = Pathname & AssyName & ".SLDASM"
      Debug.Print "Ass'y name = " & AssyName
      'Prefixe = InputBox("Vérifiez le PRÉFIXE" & Chr(13) & Chr(13) & "Forme donnée = " & Chr(13) & Chr(13) & "Préfixe  -  Acronyme  -  Sufixe numérique", "Vérifiez le PRÉFIXE ", Left(swModel.GetTitle, (InStr(swModel.GetTitle, ".") - 1)))
      'Prefixe = InputBox("Vérifiez le PRÉFIXE" & Chr(13) & Chr(13) & "Forme donnée = " & Chr(13) & Chr(13) & "Préfixe  -  Acronyme  -  Sufixe numérique", "Vérifiez le PRÉFIXE ", Left(swModel.GetTitle, (InStr(1, swModel.GetTitle, "ems", 1) - 2)))
      Prefixe = Left(swModel.GetTitle, (InStr(1, swModel.GetTitle, "ems", 1) - 2))
      'While Not IsNumeric(Sufixe)
      '  Sufixe = InputBox("Vérifiez le SUFIXE" & Chr(13) & Chr(13) & "Forme donnée = " & Chr(13) & Chr(13) & "Préfixe  -  Acronyme  -  Sufixe numérique", "Vérifiez le SUFIXE ", 1)
      'Wend
      Sufixe = 1
      'Debug.Print Format(Sufixe, "00")
      'Debug.Print IsNumeric(Sufixe)

      Set swFeatMgr = swModel.FeatureManager

      Set thisFeat = swModel.FeatureByName("Solid Bodies")
      Set cutListFolder = thisFeat.GetSpecificFeature2
      Debug.Print cutListFolder.SetAutomaticCutList(True)
          If Not cutListFolder Is Nothing And cutListFolder.UpdateCutList Then
          Debug.Print "CutListFolder Updated"
        
          Set thisSubFeat = thisFeat.GetFirstSubFeature
             
              Do While Not thisSubFeat Is Nothing
                  If thisSubFeat.GetTypeName = "CutListFolder" Then
                     Debug.Print " - - - - - - - - - - - - - - - - - - - - - - "
                     Debug.Print thisSubFeat.Description
                     Set cutListFolder = thisSubFeat.GetSpecificFeature2
                  End If
                 
                  If Not cutListFolder Is Nothing And cutListFolder.GetBodyCount > 0 Then
                     
                      Set custPropMgr = thisSubFeat.CustomPropertyManager
                        nameS = custPropMgr.GetNames
      '                  Debug.Print thisSubFeat.Select2(True, 0)
                'for sheetmetal
                               'check to see if it contains a property called Bends if so it is sheetmetal
                          If UBound(Filter(nameS, "Bends")) > -1 Then
                                  boolstatus = custPropMgr.Get4("Description", True, retDescription, retDescription1)
                                  boolstatus = custPropMgr.Get4("Sheet Metal Thickness", True, retSheet, retSheet1)
                                  boolstatus = custPropMgr.Get4("Bounding Box Width", True, retWidth, retWidth1)
                                  boolstatus = custPropMgr.Get4("Bounding Box Length", True, retLength, retLength1)
                                     
                                      'perform check to make sure "sheet metal thickness@@@CUTLISTITEM......" has not been already added
                                      boolstatus = InStr(1, retDescription, retWidth)
                                          If boolstatus = False Then
                                              value = custPropMgr.Delete("Description")
                                              value = custPropMgr.Add2("Description", swCustomInfoText, "PL  " + retSheet + " x " + retWidth + " x " + retLength)
      '                                        Debug.Print thisSubFeat.Select2(True, 0)
                                          End If
                          End If
                'for weldments
                              'check to see if it contains a property called ANGLE1 if so it is weldment
                          If UBound(Filter(nameS, "ANGLE1")) > -1 Then

                                      boolstatus = custPropMgr.Get4("ASS_CODEPRODUIT", True, retASS_CODEPRODUIT, retASS_CODEPRODUIT1)
                                      boolstatus = custPropMgr.Get4("SW_NAMEPART", True, retDescription, retDescription1)
                                      boolstatus = custPropMgr.Get4("LONGUEUR", True, retLength, retLength1)
                                     
      '---
                              Debug.Print "body count = " & cutListFolder.GetBodyCount
      'While IsNumeric(Acronyme)
      '  Acronyme = InputBox("Vérifiez l'ACRONYME " & Chr(13) & Chr(13) & "Forme donnée = " & Chr(13) & Chr(13) & "Préfixe  -  Acronyme  -  Sufixe numérique", "Vérifiez l'ACRONYME ", Left(retASS_CODEPRODUIT1, (InStr(retASS_CODEPRODUIT1, "-") - 1)))
      'Wend
      Acronyme = Left(retASS_CODEPRODUIT1, (InStr(retASS_CODEPRODUIT1, "-") - 1))
      '                        Debug.Print Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00")
                              cutlistfolderbodies = cutListFolder.GetBodies
                              For i = 1 To cutListFolder.GetBodyCount
                                If cutListFolder.GetBodyCount > 1 Then
                                  Debug.Print cutlistfolderbodies(i - 1).Name & " -- renommé --> " & Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00") & "[" & i & "]"
                                  cutlistfolderbodies(i - 1).Name = Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00") & "[" & i & "]"
                                Else
                                  Debug.Print cutlistfolderbodies(i - 1).Name & " -- renommé --> " & Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00")
                                  cutlistfolderbodies(i - 1).Name = Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00")
                                End If
                                If i = 1 Then
                                   Debug.Print "fileNames(" & j & ") = " & Pathname & Prefixe & "-" & Acronyme & "-" & Format(Sufixe, "00") & ".SLDPRT"
                                   Debug.Print "selection ID = " & cutlistfolderbodies(i - 1).GetSelectionId
      '                             Debug.Print cutlistfolderbodies(i - 1).GetType
                                  retval = swModExt.SelectByID2(cutlistfolderbodies(i - 1).GetSelectionId, "SOLIDBODY", 0#, 0#, 0#, True, 0, Nothing, swSelectOptionDefault): Debug.Assert retval
      '                           value = instance.SelectByID2(Name       , Type           , X, Y, Z, Append, Mark, Callout, SelectOption)
                                  
                                End If
                              Next i
      '---
                                      'perform check to make sure "LENGTH@@@CUTLISTITEM......" has not been already added
                                      boolstatus = InStr(1, retDescription, retLength)
                                          If boolstatus = False Then
                                              value = custPropMgr.Delete("Description")
                                              value = custPropMgr.Add2("Description", swCustomInfoText, retDescription + " x " + retLength1)
      '                                        Debug.Print thisSubFeat.Select2(True, 0)
                                          End If
                                 
                          End If
                         
                         
                         
                      End If
                
                  Set thisSubFeat = thisSubFeat.GetNextSubFeature
                  j = j + 1
                  Sufixe = Sufixe + 1
              Loop
         
      End If
      fileNameVar = fileNames
      'Set BodiesToSave = swSelMgr.GetPreSelectedObject()
      'retval = swFeatMgr.CreateSaveBodyFeature(BodiesToSave, fileNameVar, AssyName, False, False)
      value = swApp.SendMsgToUser2("The Highlighted Bodies Cutlist Properties Were Updated", swMbWarning, swMbOk)
      retval = swModel.ForceRebuild()
      End Sub