Macro for Renaming all Sketches

[Tera]

I've been looking for a macro to rename all sketches in feature tree to the name of the feature it belongs to + Sketch.
Something like :
-

2024-02-07_15-25-59.png (4.82 KiB) Viewed 1259 times

-
Does anyone know a macro that does something like this?

thanks.

[gupta9665]

There is a macro to hide all sketches in a model but I have not seen a one to rename them based on their feature name. This one will have to be made.

[josh]

How would it work when sketches are shared?

[Tera]

How would it work when sketches are shared?

We never use shared Sketches.
But for the sake of changes in our workflow in future, I prefer it be named with the first feature that use that sketch.
If it makes any problem, renaming it to the last feature is OK as well.


thanks.

[Tera]

Now that it seems what I need is not possible,
is it possible to rename only the selected sketch to --> the name of the feature it belongs to + SK?

thanks again.

[gupta9665]

Here is a quick (dirty) macro that does the job.

Code: Select all

Sub Mian()

Dim swApp           As SldWorks.SldWorks
Dim swPart          As SldWorks.PartDoc
Dim swFeat          As SldWorks.Feature
Dim swSubFeature    As SldWorks.Feature
Dim FeatureName     As String
Dim i               As Integer


Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FirstFeature


While Not swFeat Is Nothing

  If swFeat.GetTypeName2 <> "ProfileFeature" Then
    Set swSubFeature = swFeat.GetFirstSubFeature
    While Not swSubFeature Is Nothing
    
     If swSubFeature.GetTypeName2 = "ProfileFeature" Then
    
     FeatureName = swFeat.Name & " Sketch"
     
     While False <> swPart.FeatureManager.IsNameUsed(swNameType_e.swFeatureName, FeatureName)
      i = i + 1
      FeatureName = swFeat.Name & " Sketch" & (i)
     Wend
     
     swSubFeature.Name = FeatureName
     
     End If
    
    Set swSubFeature = swSubFeature.GetNextSubFeature
    
    Wend
  End If

Set swFeat = swFeat.GetNextFeature

Wend

End Sub

[AlexLachance]

Here is a quick (dirty) macro that does the jib.

Code: Select all

Sub Mian()

Dim swApp           As SldWorks.SldWorks
Dim swPart          As SldWorks.PartDoc
Dim swFeat          As SldWorks.Feature
Dim swSubFeature    As SldWorks.Feature
Dim FeatureName     As String
Dim i               As Integer


Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FirstFeature


While Not swFeat Is Nothing

  If swFeat.GetTypeName2 <> "ProfileFeature" Then
    Set swSubFeature = swFeat.GetFirstSubFeature
    While Not swSubFeature Is Nothing
    
     If swSubFeature.GetTypeName2 = "ProfileFeature" Then
    
     FeatureName = swFeat.Name & " Sketch"
     
     While False <> swPart.FeatureManager.IsNameUsed(swNameType_e.swFeatureName, FeatureName)
      i = i + 1
      FeatureName = swFeat.Name & " Sketch" & (i)
     Wend
     
     swSubFeature.Name = FeatureName
     
     End If
    
    Set swSubFeature = swSubFeature.GetNextSubFeature
    
    Wend
  End If

Set swFeat = swFeat.GetNextFeature

Wend

End Sub

Deepak still beeing the man

[Tera]

Thanks to both.
Will give it a try.

[Tera]

Here is a quick (dirty) macro that does the job.

Code: Select all

Sub Mian()

Dim swApp           As SldWorks.SldWorks
Dim swPart          As SldWorks.PartDoc
Dim swFeat          As SldWorks.Feature
Dim swSubFeature    As SldWorks.Feature
Dim FeatureName     As String
Dim i               As Integer


Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FirstFeature


While Not swFeat Is Nothing

  If swFeat.GetTypeName2 <> "ProfileFeature" Then
    Set swSubFeature = swFeat.GetFirstSubFeature
    While Not swSubFeature Is Nothing
    
     If swSubFeature.GetTypeName2 = "ProfileFeature" Then
    
     FeatureName = swFeat.Name & " Sketch"
     
     While False <> swPart.FeatureManager.IsNameUsed(swNameType_e.swFeatureName, FeatureName)
      i = i + 1
      FeatureName = swFeat.Name & " Sketch" & (i)
     Wend
     
     swSubFeature.Name = FeatureName
     
     End If
    
    Set swSubFeature = swSubFeature.GetNextSubFeature
    
    Wend
  End If

Set swFeat = swFeat.GetNextFeature

Wend

End Sub

@gupta9665 Million thanks.
Works perfect.

I only had to add a If Left(swSubFeature.Name, 6) = "Sketch" Then to prevent renaming the sketches that have already been renamed manually, and add a i = 0 after GetNextFeature to reset the counter for each feature.

I really don't know how to appreciate this favor.
Thanks again.