Public Sub StandardNummerSetzen()

' Programm zur Setzen der Zeichnungsnummer
' und Eintrag als iProperty,
' das im Schriftfeld verwendet wird.
'
' Format der Zeichnungsnummer:
' 123456.ipt   -> 123456
'
'------------------------------------------------------------------------------
'
'(c) Boekels Ingenieurbüro für Maschinenbau
'
'    21.01.2006  Erstellung
'
'------------------------------------------------------------------------------

    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    If ThisApplication.ActiveDocumentType = kPartDocumentObject _
    Or ThisApplication.ActiveDocumentType = kAssemblyDocumentObject _
    Or ThisApplication.ActiveDocumentType = kDrawingDocumentObject _
    Then

        Dim sFileName As String
        Dim sPartNumber As String
        Dim iStart As Integer
        
        sFileName = oDoc.FullFileName
        
        ' Suchen des letzten "\". Das dahinter ist der Dateiname
        iStart = InStrRev(oDoc.FullFileName, "\", -1, vbTextCompare)
        sFileName = mid$(oDoc.FullFileName, iStart + 1)
        
        ' Suchen des ".". Das davor soll die Zeichnungsnummer werden.
        iStart = InStr(1, sFileName, ".", vbTextCompare)
        sFileName = Left$(sFileName, iStart - 1)
        sPartNumber = sFileName
       
        Call Property_schreiben(oDoc, "Part Number", sPartNumber)

        
        If True Then ' if false then
        ' wenn gewünscht, auch den Display-Namen lesbar machen:
        '
        ' Der Display-Name soll bestehen aus:
        ' "Teilenummer" "Trennzeichen" "Beschreibung"
        '
        ' Wenn Teilenummer oder Beschreibung leer sind, soll auch das Trennzeichen wegfallen
            
            
            Dim sDespription As String
            Dim sTrennzeichen As String
    
            sPartNumber = Property_lesen(oDoc, "Part Number")
            sDespription = Property_lesen(oDoc, "Description")
    
            If Len(sPartNumber) = 0 Or Len(sDespription) = 0 Then
                sTrennzeichen = ""
            Else
                sTrennzeichen = " - "
            End If
    
            oDoc.DisplayName = sPartNumber & sTrennzeichen & sDespription
        
        End If
    
    End If
    
    Set oDoc = Nothing

End Sub