5 Replies Latest reply on Jun 6, 2017 4:35 PM by Matt Kane

    Macro to rename all sketches in part

    Matt Kane

      Hi.

      I am attempting to write a macro to rename all sketches in a part in order (to sooth my OCD ).

      The code below works for the most part. (I'm sure it is quite sloppy, feel free to suggest improvements)

      The problem I am having is that some sketches (ones that belong to Extruded Cuts etc) seem to be both features and subfeatures and are being renamed twice.

      I can't think of a way to prevent this. Could someone please offer a suggestion.

      I have also included a sample part.

      Regards Matt

       

      Sub main()

          Set swApp = Application.SldWorks

          Set swPart = swApp.ActiveDoc

          Set swFeat = swPart.FirstFeature

       

          SketchCount = 1

       

          Do While Not swFeat Is Nothing

         

              newSketchName = "Sketch" & SketchCount

                

                  If swFeat.GetTypeName2 = "ProfileFeature" Then

                      If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then

                          Set tempFeat = swPart.FeatureByName(newSketchName)

                          tempFeat.Name = tempFeat.Name & "temp"

                      End If

                  swFeat.Name = newSketchName

                  SketchCount = SketchCount + 1

                  Else

                      Set swsubFeat = swFeat.GetFirstSubFeature

                      Do While Not swsubFeat Is Nothing

                      newSketchName = "Sketch" & SketchCount

                      If swsubFeat.GetTypeName2 = "ProfileFeature" Then

                          If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then

                          Set tempFeat = swPart.FeatureByName(newSketchName)

                          tempFeat.Name = tempFeat.Name & "temp"

                          End If

                      swsubFeat.Name = newSketchName

                      SketchCount = SketchCount + 1

                      End If

                      Set swsubFeat = swsubFeat.GetNextSubFeature

                      Loop

                  End If

                  Set swFeat = swFeat.GetNextFeature

          Loop

      End Sub

        • Re: Macro to rename all sketches in part
          Josh Brady

          I think the simplest way for you to do this would be to run through the entire thing twice.  Once would rename every sketch to "TempSketch" plus a number.  Then, on your second run through, check to see if the sketch name starts with "TempSketch".  If it does, rename it to Sketch plus your number.  If not, don't rename.  Not efficient, but neither is the entire concept of this exercise.

           

          Sub main()
              Set swApp = Application.SldWorks
              Set swPart = swApp.ActiveDoc
              Set swfeat = swPart.FirstFeature
          
              SketchCount = 1
              'First rename everything.
              Do While Not swfeat Is Nothing
             
                  newSketchName = "TempSketch" & SketchCount
                  If swfeat.GetTypeName2 = "ProfileFeature" Then
                      If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then
                          Set tempFeat = swPart.FeatureByName(newSketchName)
                          tempFeat.Name = tempFeat.Name & "temp"
                      End If
                      swfeat.Name = newSketchName
                      SketchCount = SketchCount + 1
                  Else
                      Set swsubfeat = swfeat.GetFirstSubFeature
                      
                      Do While Not swsubfeat Is Nothing
                          newSketchName = "TempSketch" & SketchCount
                          If swsubfeat.GetTypeName2 = "ProfileFeature" Then
                              If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then
                                  Set tempFeat = swPart.FeatureByName(newSketchName)
                                  tempFeat.Name = tempFeat.Name & "temp"
                              End If
                              swsubfeat.Name = newSketchName
                              SketchCount = SketchCount + 1
                          End If
                          Set swsubfeat = swsubfeat.GetNextSubFeature
                      Loop
                  End If
                  Set swfeat = swfeat.GetNextFeature
              Loop
              SketchCount = 1
              Set swfeat = swPart.FirstFeature
              Do While Not swfeat Is Nothing
             
                  newSketchName = "Sketch" & SketchCount
                  If swfeat.GetTypeName2 = "ProfileFeature" Then
                      If Left(swfeat.Name, 10) = "TempSketch" Then
                          If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then
                              Set tempFeat = swPart.FeatureByName(newSketchName)
                              tempFeat.Name = tempFeat.Name & "temp"
                          End If
                          swfeat.Name = newSketchName
                          SketchCount = SketchCount + 1
                      End If
                  Else
                      Set swsubfeat = swfeat.GetFirstSubFeature
                      Do While Not swsubfeat Is Nothing
                          newSketchName = "Sketch" & SketchCount
                          If swsubfeat.GetTypeName2 = "ProfileFeature" Then
                              If Left(swsubfeat.Name, 10) = "TempSketch" Then
                                  If swPart.Extension.SelectByID2(newSketchName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0) = True Then
                                      Set tempFeat = swPart.FeatureByName(newSketchName)
                                      tempFeat.Name = tempFeat.Name & "temp"
                                  End If
                                  swsubfeat.Name = newSketchName
                                  SketchCount = SketchCount + 1
                              End If
                          End If
                          Set swsubfeat = swsubfeat.GetNextSubFeature
                      Loop
                  End If
                  Set swfeat = swfeat.GetNextFeature
              Loop
          End Sub
          
          • Re: Macro to rename all sketches in part
            Steve Calvert

            That's some serious CDO (OCD but in the right order)...

             

            Steve C