Macro for Renaming all Sketches
Macro for Renaming all Sketches
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 :
- -
Does anyone know a macro that does something like this?
thanks.
Something like :
- -
Does anyone know a macro that does something like this?
thanks.
Here is a quick (dirty) macro that does the job.
Go to full postCode: 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
Re: Macro for Renaming all Sketches
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.
Deepak Gupta
SOLIDWORKS Consultant/Blogger
SOLIDWORKS Consultant/Blogger
Re: Macro for Renaming all Sketches
How would it work when sketches are shared?
Re: Macro for Renaming all Sketches
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.
Re: Macro for Renaming all Sketches
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.
is it possible to rename only the selected sketch to --> the name of the feature it belongs to + SK?
thanks again.
Re: Macro for Renaming all Sketches
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
Deepak Gupta
SOLIDWORKS Consultant/Blogger
SOLIDWORKS Consultant/Blogger
- AlexLachance
- Posts: 2226
- Joined: Thu Mar 11, 2021 8:14 am
- Location: Quebec
- x 2419
- x 2061
Re: Macro for Renaming all Sketches
gupta9665 wrote: ↑Wed Feb 14, 2024 2:46 am 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
Re: Macro for Renaming all Sketches
Thanks to both.
Will give it a try.
Will give it a try.
Re: Macro for Renaming all Sketches
@gupta9665 Million thanks.gupta9665 wrote: ↑Wed Feb 14, 2024 2:46 am 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
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.