Attribute VB_Name = "Rename_Browser"
Public Sub Rename_Browser()

If Not MsgBox("Benennt die Browser-Einträge entsprechend der jeweiligen Features um." & vbCrLf & vbCrLf & _
        "Nur in Parts und Assemblies!" & vbCrLf, vbOKCancel) = vbOK Then
        Exit Sub
End If


If ThisApplication.ActiveDocument.DocumentType = kAssemblyDocumentObject Then
        
        ThisApplication.StatusBarText = "Renaming Assembly"
        
        Dim assyodoc As AssemblyDocument
        Set assyodoc = ThisApplication.ActiveDocument
        Dim AssyoProp As Property
        Set AssyoProp = assyodoc.PropertySets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kPartNumberDesignTrackingProperties)
        
        assyodoc.DisplayName = AssyoProp.Value
        
        Dim Assyapp As Application
        Dim assyDoc As AssemblyDocument
        
        Set Assyapp = ThisApplication
        Set assyDoc = Assyapp.ActiveDocument
        
        Dim ACounter1 As Integer
        Dim ACounter2 As Integer
        
        ACounter1 = 0
        ACounter2 = 1
        
        For c = 1 To assyDoc.ComponentDefinition.Occurrences.Count
            cprop = assyDoc.ComponentDefinition.Occurrences(c).Definition.Document.PropertySets.Item("Summary Information").ItemByPropId(2).Value
            If cprop = Null Then cprop = "<Missing data!>"
            assyDoc.ComponentDefinition.Occurrences(c).name = ACounter1 & "_" & cprop
            ThisApplication.StatusBarText = "Renaming Assembly Components - " & ACounter1
            ACounter1 = ACounter1 + 1
        Next c
        
        For A = 1 To assyDoc.ComponentDefinition.Occurrences.Count
            aprop = assyDoc.ComponentDefinition.Occurrences(A).Definition.Document.PropertySets.Item("Design Tracking Properties").ItemByPropId(5).Value
            If aprop = Null Then aprop = "<Missing data!>"
            assyDoc.ComponentDefinition.Occurrences(A).name = aprop & "_" & ACounter2
            ThisApplication.StatusBarText = "Renaming Assembly Components - " & ACounter2
            ACounter2 = ACounter2 + 1
        Next A
        
        ACounter1 = 0
        ACounter2 = 0
        
        ThisApplication.StatusBarText = "Renaming Constraints To Their Default Value"
        
        Dim oAsmCompDef As AssemblyComponentDefinition
        Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
        Dim oConstraint As AssemblyConstraint
        Dim ACounter As String
        
        ACounter = 1
        On Error Resume Next
        
        For Each oConstraint In oAsmCompDef.Constraints
            Select Case oConstraint.Type
            Case kAngleConstraintObject
                oConstraint.name = "Angle" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kFlushConstraintObject
                oConstraint.name = "Flush" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kInsertConstraintObject
                oConstraint.name = "Insert" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kMateConstraintObject
                oConstraint.name = "Mate" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kTangentConstraintObject
                oConstraint.name = "Tangent" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kTransitionalConstraintObject
                oConstraint.name = "Transitional" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kRotateRotateConstraintObject
                oConstraint.name = "Rotate" & ":" & ACounter
                    ACounter = ACounter + 1
            Case kRotateTranslateConstraintObject
                oConstraint.name = "RotateTranslate" & ":" & ACounter
                    ACounter = ACounter + 1
            End Select
        Next
        
        ACounter = 1
        
        ThisApplication.StatusBarText = Null
        
        assyodoc.Update


ElseIf ThisApplication.ActiveDocument.DocumentType = kPartDocumentObject Then

        
        ThisApplication.StatusBarText = "PartDocument - Renaming Part"
        '================================================
        
        Dim partodoc As PartDocument
        Set partodoc = ThisApplication.ActiveDocument
        
        Dim PartoProp As Property
        Set PartoProp = partodoc.PropertySets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kPartNumberDesignTrackingProperties)
        partodoc.DisplayName = PartoProp.Value
        
        
        
        ThisApplication.StatusBarText = "PartDocument - Renaming Holes"
        '================================================

        On Error Resume Next
        
        Dim oPartDoc As PartDocument
        Dim oFeature As PartFeature
        Dim PCounter1 As String
        Dim name As String
        Dim HoleDia As String
        Dim HoleDia_Chars As Integer
        Dim HoleDepth, HoleDepth_Chars As Integer
        Dim CBoreDia, CBoreDepth, CBoreDiaChars As Integer
        Dim CBoredepthchars, HoleDiaP, HoleDepthP, CBoreDepthP, CBoreDiaP
        
        PCounter1 = "0"
        
        Set oPartDoc = ThisApplication.ActiveDocument
        
        For Each oFeature In oPartDoc.ComponentDefinition.Features
        
            If oFeature.Type = kHoleFeatureObject Then
                
                If oFeature.HoleType = kDrilledHole Then
                    name = "Bohrung "
                Else
                    If oFeature.HoleType = kCounterBoreHole Then
                        name = "Cbore "
                        CBoreDia = oFeature.CBoreDiameter.Expression
                        CBoreDepth = oFeature.CBoreDepth.Expression
                        CBoredepthchars = Len(CBoreDepth)
                        '''CBoreDepth = Left$(CBoreDepth, (CBoredepthchars - 4))
                        CBoreDepth = Format$(CBoreDepth, "###.####")
                        CBoreDepthP = Right$(CBoreDepth, 1)
                        CBoredepthchars = Len(CBoreDepth)
                        If CBoreDepthP = "." Then
                            CBoreDepth = Left$(CBoreDepth, (CBoredepthchars - 1))
                        End If
                        CBoreDiaChars = Len(CBoreDia)
                        '''CBoreDia = Left$(CBoreDia, (CBoreDiaChars - 4))
                        CBoreDia = Format$(CBoreDia, "###.####")
                        CBoreDiaP = Right$(CBoreDia, 1)
                        CBoreDiaChars = Len(CBoreDia)
                        If CBoreDiaP = "." Then
                            CBoreDia = Left$(CBoreDia, (CBoreDiaChars - 1))
                        End If
                        name = "Bohrung Ø" & CBoreDia & " x " & CBoreDepth & " tief, Hole "
                    Else
                        If oFeature.HoleType = kCounterSinkHole Then
                            name = "C/Sunk "
                        Else
                            name = "Tapped "
                        End If
                    End If
                End If
                
                If oFeature.Tapped Then
                    name = name & oFeature.TapInfo.ThreadDesignation
                Else
                    HoleDia = oFeature.HoleDiameter.Expression
                    HoleDia_Chars = Len(HoleDia)
                    '''HoleDia = Left$(HoleDia, (HoleDia_Chars - 4))
                    HoleDia = Format$(HoleDia, "###.####")
                    HoleDia = "Ø" & HoleDia
                    HoleDiaP = Right$(HoleDia, 1)
                    HoleDia_Chars = Len(HoleDia)
                    If HoleDiaP = "." Then
                        HoleDia = Left$(HoleDia, (HoleDia_Chars - 1))
                    End If
                    name = name & HoleDia
                End If
                
                If oFeature.ExtentType = kDistanceExtent Then
                    HoleDepth = oFeature.Extent.Distance.Expression
                    HoleDepth_Chars = Len(HoleDepth)
                    '''HoleDepth = Left$(HoleDepth, (HoleDepth_Chars - 4))
                    HoleDepth = Format$(HoleDepth, "####.###")
                    HoleDepthP = Right$(HoleDepth, 1)
                    HoleDepth_Chars = Len(HoleDepth)
                    If HoleDepthP = "." Then
                        HoleDepth = Left$(HoleDepth, (HoleDepth_Chars - 1))
                    End If
                    PCounter1 = PCounter1 + 1
                    name = name & " x " & HoleDepth & " tief_ " & PCounter1
                Else
                    HoleDepth = oFeature.Extent.Distance.Expression
                    HoleDepth_Chars = Len(HoleDepth)
                    '''HoleDepth = Left$(HoleDepth, (HoleDepth_Chars - 4))
                    HoleDepth = Format$(HoleDepth, "####.###")
                    HoleDepthP = Right$(HoleDepth, 1)
                    HoleDepth_Chars = Len(HoleDepth)
                    If HoleDepthP = "." Then
                        HoleDepth = Left$(HoleDepth, (HoleDepth_Chars - 1))
                    End If
                    PCounter1 = PCounter1 + 1
                    name = name & HoleDepth & " durch_ " & PCounter1
                End If
                
                oFeature.name = name
            End If
            
            HoleDia_Chars = Null
            HoleDepth = Null
            HoleDepth_Chars = Null
            CBoreDia = Null
            CBoreDepth = Null
            CBoreDiaChars = Null
            CBoredepthchars = Null
            name = Null
            
        Next
            
            
            
        ThisApplication.StatusBarText = "PartDocument - Renaming Features"
        '================================================
        
        Set oPartDoc = ThisApplication.ActiveDocument
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            name = Null
            PCounter = "0"
        Next
        
        Dim ExtrusionCounter As Integer
        ExtrusionCounter = 1
        Dim RevolutionCounter As Integer
        RevolutionCounter = 1
        Dim CircPatternCounter As Integer
        CircPatternCounter = 1
        Dim RetPatternCounter As Integer
        RetPatternCounter = 1
        Dim ChamferCounter As Integer
        ChamferCounter = 1
        Dim FilletCounter As Integer
        FilletCounter = 1
        Dim ThreadCounter As Integer
        ThreadCounter = 1
        Dim LoftCounter As Integer
        LoftCounter = 1
        Dim ShellCounter As Integer
        ShellCounter = 1
        Dim SweepCounter As Integer
        SweepCounter = 1
        Dim FlangeCounter As Integer
        FlangeCounter = 1
        Dim FaceDraftCounter As Integer
        FaceDraftCounter = 1
        Dim MoveFaceCounter As Integer
        MoveFaceCounter = 1
        
        '''''Renaming Extrusions
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83910656 Then
                Dim ExtrusionWeldName
                ExtrusionWeldName = oFeature.name
                ExtrusionWeldName = Right$(oFeature.name, 4)
                If ExtrusionWeldName <> "WELD" Then
                    name = "Extrusion_" & ExtrusionCounter
                Else: name = "Extrusion_" & ExtrusionCounter & " WELD"
                End If
                oFeature.name = name
                ExtrusionCounter = ExtrusionCounter + 1
            End If
        Next
        
        '''''Renaming MoveFaceFeature
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = kMoveFaceFeatureObject Then
                name = "Fläche verschieben_" & MoveFaceCounter
                oFeature.name = name
                MoveFaceCounter = MoveFaceCounter + 1
            End If
        Next
        
        '''''Renaming FaceDraft
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83911168 Then
                name = "FaceDraft_" & FaceDraftCounter
                oFeature.name = name
                FaceDraftCounter = FaceDraftCounter + 1
            End If
        Next
        
        '''''Renaming Revolutions
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83914240 Then
                name = "Drehung_" & RevolutionCounter
                oFeature.name = name
                RevolutionCounter = RevolutionCounter + 1
            End If
        Next
        
        '''''Renaming Circular Patterns
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83909632 Then
                name = "Circular Pattern_" & CircPatternCounter
                oFeature.name = name
                CircPatternCounter = CircPatternCounter + 1
            End If
        Next
        
        '''''Renaming Rectangular Patterns
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83913728 Then
                name = "Rectangular Pattern_" & RetPatternCounter
                oFeature.name = name
                RetPatternCounter = RetPatternCounter + 1
            End If
        Next
        
        '''''Renaming Chamfers
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83909120 Then
                Dim ChamferWeldName
                ChamferWeldName = oFeature.name
                ChamferWeldName = Right$(oFeature.name, 4)
                If ChamferWeldName <> "WELD" Then
                    name = "Fase_" & ChamferCounter
                Else: name = "Chamfer_" & ChamferCounter & " WELD"
                End If
                oFeature.name = name
                ChamferCounter = ChamferCounter + 1
            End If
        Next
        
        '''''Renaming Fillets
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83911680 Then
                name = "Radius_" & FilletCounter
                oFeature.name = name
                FilletCounter = FilletCounter + 1
            End If
        Next
        
        '''''Renaming Lofts
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83912704 Then
                name = "Loft_" & LoftCounter
                oFeature.name = name
                LoftCounter = LoftCounter + 1
            End If
        Next
        
        '''''Renaming Shells
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83915264 Then
                name = "Shell_" & ShellCounter
                oFeature.name = name
                ShellCounter = ShellCounter + 1
            End If
        Next
        
        '''''Renaming Sweeps
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 83916288 Then
                name = "Sweep_" & ShellCounter
                oFeature.name = name
                SweepCounter = SweepCounter + 1
            End If
        Next
        
        '''''Renaming Flanges
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = 151001344 Then
                name = "Flange_" & FlangeCounter
                oFeature.name = name
                FlangeCounter = FlangeCounter + 1
            End If
        Next
        
        '''''Renaming Threads
        For Each oFeature In oPartDoc.ComponentDefinition.Features
            If oFeature.Type = kThreadFeatureObject Then
                name = "Thread " & oFeature.ThreadInfo.PitchDesignation & "_" & ThreadCounter
                oFeature.name = name
                ThreadCounter = ThreadCounter + 1
            End If
        Next
        
        ThisApplication.StatusBarText = Null


        oPartDoc.Update

Else
        MsgBox "nix passiert - falscher Dokumenttyp"

End If

End Sub