Page 1 of 1
Macro for Renaming all Sketches
Posted: Wed Feb 07, 2024 1:28 am
by 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 1169 times
-
Does anyone know a macro that does something like this?
thanks.
Re: Macro for Renaming all Sketches
Posted: Wed Feb 07, 2024 1:44 am
by 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.
Re: Macro for Renaming all Sketches
Posted: Wed Feb 07, 2024 7:42 am
by josh
How would it work when sketches are shared?
Re: Macro for Renaming all Sketches
Posted: Wed Feb 07, 2024 8:47 am
by Tera
josh wrote: ↑Wed Feb 07, 2024 7:42 am
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.
Re: Macro for Renaming all Sketches
Posted: Tue Feb 13, 2024 9:31 pm
by 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.
Re: Macro for Renaming all Sketches
Posted: Wed Feb 14, 2024 2:46 am
by 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
Re: Macro for Renaming all Sketches
Posted: Wed Feb 14, 2024 7:54 am
by AlexLachance
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
Posted: Wed Feb 14, 2024 6:15 pm
by Tera
Thanks to both.
Will give it a try.
Re: Macro for Renaming all Sketches
Posted: Wed Feb 14, 2024 6:21 pm
by Tera
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
@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.