Language="VBSCRIPT"

Sub CATMain()

    Dim M1, M2, M3, M4, M5, M6, M7, M8, M9, M10, M11, M12, Titel, Skin

Pfad = "\\Server\catiav5\VOLAGEN\HILFE_DATEIEN\Hilfe_Zeichnungsableit_von_Produkt.html"

    M1 = "==>  Dieses Makro erstellt Zeichnungen (von CATParts) aus einem CATProdukt. <=="
    M2 = "Folgende Schritte sind zu Beachten!"
    M3 = "Der Autor sprich sich von jeglicher Haftung frei!"
    M4 = "Dieses Makro wurde nur zu Testzwecken entwickelt. Fuer jegliche andere Art von Nutzung ist ausschlieÃƒÅ¸lich der Anwender haftbar."
    M5 = "Das Makro unterliegt keinen gesetzlichen Richtlinien. Es kann vervielfaelltigt, geaendert und verkauft werden."
    M6 = "                    Autor:     Karsten Siebert"
    M7 = "                    Datum:    09.12.2008"
    M8 = "Fuer weiteren Support und Hilfe benutzen sie bitte die Hilfedatei"
    M9 = "!!! Um die Hilfedatei zu Benutzen OEFFEN Sie das Makro und Tragen Sie in der Zeile (Pfad\XXXX\) den Pfad ein wo Sie diese abgespeichert haben !!!"
    M10 = "<<<< Mit dem Klick auf den >>JA<< Button wird das Makro gestartet und gleichzeitig die Hilfedatei aufgerufen um falls ein einrichten der Hilfedatei nÃ¶tig ist muss das nachfolgende Fenster betÃ¤tigt werden um das Makro zu STARTEN >>>"
    M11 = "<<<< Mit dem Klick auf den >>NEIN<< Button wird das Makro SOFORT GESTARTET >>>"
    Titel = "Disclaimer"
    Skin = vbExclamation + vbYesNoCancel   'Ignore + vbIgnore

    Disclaimer = MsgBox(M1 + Chr(10) + Chr(10) + M2 + Chr(10) + M3 + Chr(10) + M4 + Chr(10) + M5 + Chr(10) + M6 + Chr(10) + M7 + Chr(10) + M8 + Chr(10) + Chr(10) + M9 + Chr(10) + Chr(10) + M10 + Chr(10) + Chr(10) + Chr(10) + M11, Skin, Titel)
     STARTEN   
	If Disclaimer = vbCancel Then
            Box = MsgBox("Der Anwender hat sich gegen die Nutzung des Makros entschieden" + Chr(10) + "Das Makro wird nun beendet", vbCritical, "Abbruch durch Anwender")
            Exit Sub
        End If

	If Disclaimer = vbNo Then
            Box = MsgBox("Das Makro Startet ohne Hilfedatei" + Chr(10) + "", vbExclamation, "Titel")
            
            STARTEN

        End If

	If Disclaimer = vbYes Then
         ExplorerPath = "C:\WINDOWS\explorer.exe"
         Explorer = CATIA.SystemService.ExecuteProcessus(ExplorerPath & " " & Pfad)
        
                 S1 = "==>  DAS MAKRO STARTEN ? <=="
    		     Titel = "START"
                 Skin = vbQuestion + vbYesNo
	           START = MsgBox(S1, Skin, Titel)

               If START = vbNo Then
                   Box = MsgBox("Der Anwender hat sich gegen die Nutzung des Makros entschieden" + Chr(10) + "Das Makro wird nun beendet", vbCritical, "Abbruch durch Anwender")
                   Exit Sub
               End If



         STARTEN

    	End If

End Sub


Sub STARTEN




Dim UserSelektion As Selection
Set  UserSelektion = CATIA.ActiveDocument.Selection

For I = 1 to UserSelektion.Count 
Name = (UserSelektion.Item(I).Value.ReferenceProduct.Name)
FullNameX = (UserSelektion.Item(I).Value.ReferenceProduct.Parent.Fullname)



next


On Error Resume Next
CATIA.Documents.Open (FullNameX)

if Err Then 
Box = msgbox ("KEIN TEIL SELEKTIERT" , vbCritical, "Abbruch")
Exit sub
end if

xName = CATIA.ActiveDocument.Name

'msgbox Name
'msgbox xName
'msgbox FullNameX

'---------------PART AUS PRODUKT AUSWAEHLEN 
Set Document = CATIA.ActiveDocument 
Dim iSel, iStatus, sFilter(0) 
set iSel = CATIA.ActiveDocument.Selection

sFilter(0) = "Part" 
iStatus = iSel.SelectElement3(sFilter, "Part selektieren / ESC bei keine Auswahl", False, CATMultiSelTriggWhenSelPerf, False)

If iStatus = "Normal" Then 
Else
MsgBox "Abbruch(Cancel) der Auswahl", vbOKOnly + vbCritical, " Abbruch "
Exit Sub 
End If 

Set oPart = Document.Selection.Item(1).Value 
iSel.clear 
'----------------PROJEKTIONSFLAECHE AUSWAEHLEN 
Dim myArrayAxis1(2), myArrayAxis2(2), jSel, jStatus, pFilter(0) 
set jSel = CATIA.ActiveDocument.Selection

'was soll ausgewÃ¤hlt werden
pFilter(0) = "Face"

'hier wird die Selektion vorgenommen 
jStatus = jSel.SelectElement3(pFilter, "Flaeche selektieren / ESC bei keine Auswahl", False, CATMultiSelTriggWhenSelPerf, False)

If jStatus = "Normal" Then 
Else
MsgBox "Abbruch(Cancel) der Auswahl", vbOKOnly + vbCritical, " Abbruch "
Exit Sub 
End If


Set oSelElem = Document.Selection.Item(1).Value 
'die Flaeche ist Ã¼ber zwei Achsen bestimmt die man mit get.... bekommt
oSelElem.GetFirstAxis myArrayAxis1 
oSelElem.GetSecondAxis myArrayAxis2 


CATIA.ActiveDocument.Close


'-----------SPLIT "myArrayAxis1" AND "myArrayAxis2" INTO SEPERATE COORDINATES 
x1 = myArrayAxis1(0) 
y1 = myArrayAxis1(1) 
z1 = myArrayAxis1(2) 
x2 = myArrayAxis2(0) 
y2 = myArrayAxis2(1) 
z2 = myArrayAxis2(2) 
jSel.clear 

'-------------------------------------------------------------

sInputFile = CATIA.FileSelectionBox("Zeichnung auswaehlen und ab geht's!", "*.CATDrawing", CatFileSelectionModeOpen)
Set oDoc = CATIA.Documents.Open(sInputFile)

'-----------------------------------------------------

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Item(1) '("Blatt .1")
Dim drawingViews1 As DrawingViews
Set drawingViews1 = drawingSheet1.Views
Dim drawingView1 As DrawingView
Set drawingView1 = drawingViews1.Add("AutomaticNaming")
Dim drawingViewGenerativeLinks1 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
Dim drawingViewGenerativeBehavior1 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim partDocument1 As Document
Set partDocument1 = documents1.Item (xName)
Dim product1 As CATBaseDispatch
Set product1 = partDocument1.GetItem (Name)
drawingViewGenerativeBehavior1.Document = product1
drawingViewGenerativeBehavior1.DefineFrontView x1, y1, z1, x2, y2, z2 '0.000000, 1.000000, 0.000000, 0.000000, 0.000000, 1.000000
drawingView1.x = 50
drawingView1.y = 200 '148.500000
drawingView1.Scale = 1.000000
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior1.Update 
drawingView1.Activate 
'------------------------------------------------------------------------
Set drawingDocument1 = CATIA.ActiveDocument
Set drawingSheets1 = drawingDocument1.Sheets
Set drawingSheet1 = drawingSheets1.ActiveSheet
Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.ActiveView
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
Dim drawingView2 As DrawingView
Set drawingView2 = drawingViews1.Add("AutomaticNaming")
Dim drawingViewGenerativeBehavior2 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior2 = drawingView2.GenerativeBehavior
drawingViewGenerativeBehavior2.DefineProjectionView drawingViewGenerativeBehavior1, catTopView
Dim drawingViewGenerativeLinks2 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks2 = drawingView2.GenerativeLinks
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
drawingViewGenerativeLinks1.CopyLinksTo drawingViewGenerativeLinks2
drawingView2.x = 50
drawingView2.y = 120
Dim double1 As Double
double1 = drawingView1.Scale
drawingView2.Scale = 1.000000
Set drawingViewGenerativeBehavior2 = drawingView2.GenerativeBehavior
drawingViewGenerativeBehavior2.Update 
'---------------------------------------------------------------------------------
drawingView2.ReferenceView = drawingView1
drawingView2.AlignedWithReferenceView 
Set drawingDocument1 = CATIA.ActiveDocument
Set drawingSheets1 = drawingDocument1.Sheets
Set drawingSheet1 = drawingSheets1.ActiveSheet
Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.ActiveView
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
Dim drawingView3 As DrawingView
Set drawingView3 = drawingViews1.Add("AutomaticNaming")
Dim drawingViewGenerativeBehavior3 As DrawingViewGenerativeBehavior
Set drawingViewGenerativeBehavior3 = drawingView3.GenerativeBehavior
drawingViewGenerativeBehavior3.DefineProjectionView drawingViewGenerativeBehavior1, catLeftView
Dim drawingViewGenerativeLinks3 As DrawingViewGenerativeLinks
Set drawingViewGenerativeLinks3 = drawingView3.GenerativeLinks
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
drawingViewGenerativeLinks1.CopyLinksTo drawingViewGenerativeLinks3
drawingView3.x = 130
drawingView3.y = 200
Dim double2 As Double
double2 = drawingView1.Scale
drawingView3.Scale = 1.000000
Set drawingViewGenerativeBehavior3 = drawingView3.GenerativeBehavior
drawingViewGenerativeBehavior3.Update 
drawingView3.ReferenceView = drawingView1
drawingView3.AlignedWithReferenceView


'----------------------------------------------------------------------------------------------------

Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.Item(4)'("Vorderansicht")
drawingView1.Activate

'__________________________Dateipad LESEN___________________________________________
Dateipfad = drawingView1.GenerativeBehavior.document.ReferenceProduct.Parent.Path
'FullName = drawingView1.GenerativeBehavior.document.ReferenceProduct.Parent.Fullname
Name = drawingView1.GenerativeBehavior.document.ReferenceProduct.Parent.name
NameY = drawingView1.GenerativeBehavior.document.ReferenceProduct.name
'________________________________________________________________________________________ 
'__________________________________ STRING zerlegen ____________________________

On Error Resume Next

vTXT = Left(Name, InStrRev(Name, ".CAT") - 1) 
BenennTXT = Right( vTXT, Len( vTXT) -18 ) 'Right Left
 
PosTXT1 = Left(vTXT, InStrRev(vTXT, "_") - 1)
PosTXT2 = Right( PosTXT1, Len(PosTXT1) -14 ) 'Right Left
 
AuftragNrTXT1 = Left( PosTXT1, Len( PosTXT1) -9 ) 'Right Left 

bgTXT1 = Left( PosTXT1, Len( PosTXT1) -5 ) 'Right Left
bgTXT2 = Right( bgTXT1, Len( bgTXT1) -9 ) 'Right Left
'________________________________________________________________________________________

Dim origstr As String
	origstr = "AlMg 4.5"
	Mat = Inputbox ("Bitte geben Sie ein Material an.", "Material", origstr)

'________________________________________________________________________________________


UseName = CATIA.SystemService.Environ("USERNAME")
'Msgbox UseName

Datum = CStr(Date)
'Msgbox Datum

'msgbox UseName

if UseName = "k.siebert" Then
NameU = "Sieb" + Datum
end if

if UseName = "" Then
NameU = "User" + Datum
end if


if UseName = "m.pape" Then
NameU = "Werner" + Datum
end if

if UseName = "m.heyke" Then
NameU = "He" + Datum
end if

if UseName = "u.mathe" Then
NameU = "UWE" + Datum
end if

if UseName = "i.abdusamatov" Then
NameU = "Jan" + Datum
end if


'__________________Ansicht bestimmen_________________________________ 


Set oDraw = CATIA.ActiveDocument                                                                            ' Zeichnung als aktives Dokument bestimmen
Set oSheets = oDraw.Sheets
oDraw.Sheets.Item(1).Activate
Set oSheet = oSheets.ActiveSheet
oSheet.Activate

Dim j As Integer

dim i as integer
dim oText as DrawingText
dim ocText as DrawingTexts 
'Schleife geht durch alle Texte eines Views durch
'Musst nur rausfinden, welche View der BackgroundView ist
'Und den an drawingView1 zuweisen 

For k = 1 To oDraw.Sheets.Count                       'Schleife fuer alle Sheets
        Set oSheet = oDraw.Sheets.Item(k)
        'If oSheet.IsDetail Then                         'Ist das Sheet kein Detail-Sheet?
            For j = 1 To oSheet.Views.Count             'Schleife fuer alle Views im Sheet
            Set oView = oSheet.Views.Item(j)
                Set ocText = oView.Texts
                    Z = 0
                        For s = 1 To ocText.Count
                        Set oText = ocText.Item(s)

                        If oText.Name = "Name1" Then
                        oText.Text = NameU
                        Z = 1
                        End If

                        If oText.Name = "Mat1" Then
                        oText.Text = Mat
                        Z = 1
                        End If

                        If oText.Name = "Benennung" Then
                        oText.Text = BenennTXT
                        Z = 1
                        End If


                        If oText.Name = "Pos" Then
                        oText.Text = PosTXT2
                        Z = 1
                        End If

                        If oText.Name = "Auftrag" Then
                        oText.Text = AuftragNrTXT1
                        Z = 1
                        End If

                        If oText.Name = "BG" Then
                        oText.Text = bgTXT2
                        Z = 1
                        End If

				Next
              
            Next
        'End If
    Next

Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.Item("Vorderansicht")
drawingView1.Activate 

'-------------------------------------------------------------


'msgbox Dateipfad
'msgbox NameY

CATIA.DisplayFileAlerts = False
Datei = Dateipfad  &  "\" & NameY & ".CATDrawing"

CATIA.ActiveDocument.SaveAS Datei
'CATIA.ActiveDocument.Close


End Sub
