Attribute VB_Name = "Gewinde"
Option Explicit
Private Function Regelgewinde(bZuRegel As Boolean, sPitch As String) As String
Dim sGMS As String
Dim sGOS As String

sGMS = "|M1x0.25|M1.1x0.25|M1.2x0.25|M1.4x0.3|M1.6x0.35|M1.8x0.35|M2x0.4|M2.2x0.45|M2.5x0.45|M3x0.5|M3.5x0.6|M4x0.7|M4.5x0.75|M5x0.8|M6x1|M7x1|M8x1.25|M9x1.25|M10x1.5|M11x1.5|M12x1.75|M14x2|M16x2|M18x2.5|M20x2.5|M22x3|M24x3|M27x3|M30x3.5|M33x3.5|M36x4|M39x4|M42x4.5|M45x4.5|M48x5|M52x5|M56x6.5|M60x5.5|M64x6|M68x6|"
sGOS = "|M1|    |M1,1|    |M1,2|    |M1,4|   |M1,6|    |M1,8|    |M2|   |M2,2|    |M2,5|    |M3|   |M3,5|   |M4|   |M4,5|    |M5|   |M6| |M7| |M8|    |M9|    |M10|   |M11|   |M12|    |M14| |M16| |M18|   |M20|   |M22| |M24| |M27| |M30|   |M33|   |M36| |M39| |M42|   |M45|   |M48| |M52| |M56|   |M60|   |M64| |M68| |"

Regelgewinde = sPitch
If bZuRegel Then
  'Verbergen: Suche in GMS, ersetzte durch GOS
  If InStr(sGMS, "|" + sPitch + "|") > 0 Then
    Regelgewinde = Mid(sGOS, InStr(sGMS, "|" + sPitch + "|") + 1, 10)
    Regelgewinde = Left(Regelgewinde, InStr(Regelgewinde, "|") - 1)
  End If
Else
  'Wiederherstellen
  If InStr(sGOS, "|" + sPitch + "|") > 0 Then
    Regelgewinde = Mid(sGMS, InStr(sGOS, "|" + sPitch + "|") + 1, 10)
    Regelgewinde = Left(Regelgewinde, InStr(Regelgewinde, "|") - 1)
  End If
End If
  
End Function


Private Sub SteigungÄndern(ZuRegel As Boolean)
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument

'ist part?
If oDoc.DocumentType = kPartDocumentObject Then
  WorkInPart oDoc, ZuRegel
End If
'ist assembly?
If oDoc.DocumentType = kAssemblyDocumentObject Then
  Dim oOcc As ComponentOccurrence
  For Each oOcc In oDoc.ComponentDefinition.Occurrences
    WorkInAssembly oOcc, ZuRegel
  Next
End If
'Aktualisiere
oDoc.Update

End Sub

Private Sub WorkInPart(oDoc As PartDocument, ZuRegel As Boolean)

Dim oHF As HoleFeature
Dim oTF As ThreadFeature

For Each oHF In oDoc.ComponentDefinition.Features.HoleFeatures
  If oHF.Tapped Then
    oHF.TapInfo.PitchDesignation = Regelgewinde(ZuRegel, oHF.TapInfo.PitchDesignation)
  End If
Next
For Each oTF In oDoc.ComponentDefinition.Features.ThreadFeatures
  If oTF.ThreadInfoType = kStandardThread Then
    oTF.ThreadInfo.PitchDesignation = Regelgewinde(ZuRegel, oTF.ThreadInfo.PitchDesignation)
  End If
Next
End Sub

Private Sub WorkInAssembly(oOcc As ComponentOccurrence, ZuRegel As Boolean)

If oOcc.DefinitionDocumentType = kPartDocumentObject Then
  WorkInPart oOcc.Definition.Document, ZuRegel
Else
  Dim oSubOcc As ComponentOccurrence
  For Each oSubOcc In oOcc.SubOccurrences
    WorkInAssembly oSubOcc, ZuRegel
  Next
End If

End Sub


Sub SteigungVerbergen()
  SteigungÄndern (True)
End Sub

Sub SteigungZeigen()
  SteigungÄndern (False)
End Sub