1 Reply Latest reply on Jan 4, 2016 1:20 PM by Michael Spens

    Rename Fillets

    Aj Bosma

      Is it possible to "remodel" this macro so that is does rename all the fillets in a part?

       

       

       

      Option Explicit
      Dim swApp As SldWorks.SldWorks
      Dim swModel As SldWorks.ModelDoc2
      Dim swFeatMgr As SldWorks.FeatureManager
      Dim vFeatures As Variant
      Dim sFeatureNames() As String
      Dim swFeature As SldWorks.Feature
      Dim swChamfer As SldWorks.ChamferFeatureData2

      Const Pi As Double = 3.14159265358979
      Dim Digits As Long

      Sub main()
      Dim i As Integer
      Dim k As Integer

      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc

      If swModel Is Nothing Then Exit Sub
      If Not swModel.GetType = swDocumentTypes_e.swDocPART Then Exit Sub

      Set swFeatMgr = swModel.FeatureManager
      vFeatures = swFeatMgr.GetFeatures(False)

      k = 0
      Digits = 3 'Number of digits of angle to be shown in feature name

      'Set a temporary name in order to avoid possible naming conflicts
      'this might consider to be not necessary. Remove or comment the code if you want to disable it.
      ReDim sFeatureNames(UBound(vFeatures))

      For i = 0 To UBound(vFeatures)
          Set swFeature = vFeatures(i)
          If swFeature.GetTypeName2 = "Chamfer" Then
              Set swChamfer = swFeature.GetDefinition
              k = k + 1
              swFeature.Name = "Chamfer_temp_name_" & k
          End If
          sFeatureNames(i) = swFeature.Name 'Load all feature names into array to speed things up
      Next
      'End of setting temp. names to chamfers.

      For i = 0 To UBound(vFeatures)
          Set swFeature = vFeatures(i)
          If swFeature.GetTypeName2 = "Chamfer" Then
              Set swChamfer = swFeature.GetDefinition
              swFeature.Name = SetName(swChamfer.Type) 'Assign name to feature, using function SetName
              sFeatureNames(i) = swFeature.Name 'Update array with all feature names.
          End If
      Next

      End Sub

      Private Function SetName(ChamferType As Long) As String
      Dim i As Integer
      Dim k As Integer
      Dim sName As String
      Dim sNameTemp As String
      Dim iswFeature As SldWorks.Feature

      Select Case ChamferType 'Depending on chamfer type, get different data and set the feature name different.
      Case swChamferType_e.swChamferAngleDistance
      sName = "Chamfer " & swChamfer.GetEdgeChamferDistance(0) * 1000 & "x" & Round((swChamfer.EdgeChamferAngle * (180 / Pi)), Digits) & Chr(176)

      Case swChamferType_e.swChamferDistanceDistance
      sName = "Chamfer " & swChamfer.GetEdgeChamferDistance(0) * 1000 & "x" & swChamfer.GetEdgeChamferDistance(1) * 1000

      Case swChamferType_e.swChamferEqualDistance
      sName = "Chamfer " & swChamfer.GetEdgeChamferDistance(0) * 1000 & "x" & swChamfer.GetEdgeChamferDistance(0) * 1000

      Case swChamferType_e.swChamferVertex
      sName = "Chamfer " & swChamfer.GetVertexChamferDistance(0) * 1000 & "x" & swChamfer.GetVertexChamferDistance(1) * 1000 & "x" & swChamfer.GetVertexChamferDistance(2) * 1000

      End Select

      k = 1 'Since first feature is no.1.

      Restart_:
      If k > 1 Then
          sNameTemp = sName & " (" & k & ")"
      Else
          sNameTemp = sName
      End If

      For i = 0 To UBound(sFeatureNames)
          If sNameTemp = sFeatureNames(i) Then
              k = k + 1
              GoTo Restart_:
          ElseIf sNameTemp = sFeatureNames(i) Then
              k = k + 1
              GoTo Restart_:
          End If
      Next

      If k > 1 Then sName = sName & " (" & k & ")"

      SetName = sName

      End Function

        • Re: Rename Fillets
          Michael Spens

          Try this....

           

           

          Option Explicit

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swFeatMgr As SldWorks.FeatureManager

          Dim vFeatures As Variant

          Dim sFeatureNames() As String

          Dim swFeature As SldWorks.Feature

          Dim swFillet As SldWorks.SimpleFilletFeatureData2

          Const Pi As Double = 3.14159265358979

          Dim Digits As Long

          Sub main()

          Dim i As Integer

          Dim k As Integer

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          If swModel Is Nothing Then Exit Sub

          If Not swModel.GetType = swDocumentTypes_e.swDocPART Then Exit Sub

          Set swFeatMgr = swModel.FeatureManager

          vFeatures = swFeatMgr.GetFeatures(False)

          k = 0

          Digits = 3 'Number of digits of angle to be shown in feature name

          'Set a temporary name in order to avoid possible naming conflicts

          'this might consider to be not necessary. Remove or comment the code if you want to disable it.

          ReDim sFeatureNames(UBound(vFeatures))

          For i = 0 To UBound(vFeatures)

              Set swFeature = vFeatures(i)

              If swFeature.GetTypeName2 = "Fillet" Then

                  'Set swFillet = swFeature.GetDefinition

                  k = k + 1

                  swFeature.Name = "Fillet_temp_name_" & k

              End If

              sFeatureNames(i) = swFeature.Name 'Load all feature names into array to speed things up

          Next

          'End of setting temp. names to chamfers.

          For i = 0 To UBound(vFeatures)

              Set swFeature = vFeatures(i)

              If swFeature.GetTypeName2 = "Fillet" Then

                  Set swFillet = swFeature.GetDefinition

                  swFeature.Name = SetName(swFillet.Type) 'Assign name to feature, using function SetName

                  sFeatureNames(i) = swFeature.Name 'Update array with all feature names.

              End If

          Next

          End Sub

          Private Function SetName(FilletType As Long) As String

          Dim i As Integer

          Dim k As Integer

          Dim sName As String

          Dim sNameTemp As String

          Dim iswFeature As SldWorks.Feature

          sName = "Fillet " & swFillet.DefaultRadius * 1000 & "mm"

           

           

           

           

          k = 1 'Since first feature is no.1.

          Restart_:

          If k > 1 Then

              sNameTemp = sName & " (" & k & ")"

          Else

              sNameTemp = sName

          End If

          For i = 0 To UBound(sFeatureNames)

              If sNameTemp = sFeatureNames(i) Then

                  k = k + 1

                  GoTo Restart_:

              ElseIf sNameTemp = sFeatureNames(i) Then

                  k = k + 1

                  GoTo Restart_:

              End If

          Next

          If k > 1 Then sName = sName & " (" & k & ")"

          SetName = sName

          End Function