VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Change_Drawingline 
   Caption         =   "Change Drawingline"
   ClientHeight    =   2775
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   5295
   OleObjectBlob   =   "Change_Drawingline.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "Change_Drawingline"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Makro:        Change_Drawingline
' Version:      1.0
' Catia Level:  V5R19
' UIL:          English (User Interface Language)
' Autor:        Christian Obholzer
' E-Mail:       ch.obholzer@aon.at
' Erstellt:     17.11.2010
' Zweck:        Ändern von Drawinglines
'-----------------------------------------------------------------------------------
' Änderungen:   Datum, Name
'               Hier wird die Änderung angegeben
'               Datum, Name
'               Hier wird die Änderung angegeben
'-----------------------------------------------------------------------------------

Option Explicit

    '***Deklarationen
    Public intRot As Integer
    Public intGruen As Integer
    Public intBlau As Integer
    
Private Sub cmb_Color_Change()

    '***Farbe der TextBox definieren
    If Me.cmb_Color.Value = "Schwarz" Then
        Me.txt_Color.BackColor = &H0&
        intRot = 0
        intGruen = 0
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Rot" Then
        Me.txt_Color.BackColor = &H80&
        intRot = 128
        intGruen = 0
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Grün" Then
        Me.txt_Color.BackColor = &H8000&
        intRot = 0
        intGruen = 128
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Blau" Then
        Me.txt_Color.BackColor = &H800000
        intRot = 0
        intGruen = 0
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Gelb" Then
        Me.txt_Color.BackColor = &H8080&
        intRot = 128
        intGruen = 128
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Purpur" Then
        Me.txt_Color.BackColor = &H800080
        intRot = 128
        intGruen = 0
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Blaugrün" Then
        Me.txt_Color.BackColor = &H808000
        intRot = 0
        intGruen = 128
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Hellrot" Then
        Me.txt_Color.BackColor = &HFF&
        intRot = 255
        intGruen = 0
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Hellgrün" Then
        Me.txt_Color.BackColor = &HFF00&
        intRot = 0
        intGruen = 255
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Hellblau" Then
        Me.txt_Color.BackColor = &HFF0000
        intRot = 0
        intGruen = 0
        intBlau = 255
    ElseIf Me.cmb_Color.Value = "Hellgelb" Then
        Me.txt_Color.BackColor = &HFFFF&
        intRot = 255
        intGruen = 255
        intBlau = 0
    ElseIf Me.cmb_Color.Value = "Hellpurpur" Then
        Me.txt_Color.BackColor = &HFF00FF
        intRot = 255
        intGruen = 0
        intBlau = 255
    ElseIf Me.cmb_Color.Value = "Hellblaugrün" Then
        Me.txt_Color.BackColor = &HFFFF00
        intRot = 0
        intGruen = 255
        intBlau = 255
    ElseIf Me.cmb_Color.Value = "Pastellrot" Then
        Me.txt_Color.BackColor = &H8080FF
        intRot = 255
        intGruen = 128
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Pastellgrün" Then
        Me.txt_Color.BackColor = &H80FF80
        intRot = 128
        intGruen = 255
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Pastellblau" Then
        Me.txt_Color.BackColor = &HFF8080
        intRot = 128
        intGruen = 128
        intBlau = 255
    ElseIf Me.cmb_Color.Value = "Chreme" Then
        Me.txt_Color.BackColor = &H80FFFF
        intRot = 255
        intGruen = 255
        intBlau = 128
    ElseIf Me.cmb_Color.Value = "Rosa" Then
        Me.txt_Color.BackColor = &HFF80FF
        intRot = 255
        intGruen = 128
        intBlau = 255
    ElseIf Me.cmb_Color.Value = "Babyblau" Then
        Me.txt_Color.BackColor = &HFFFF80
        intRot = 128
        intGruen = 255
        intBlau = 255
    End If

End Sub

Private Sub cmd_Beenden_Click()
    
    '***Fenster schließen
    Unload Me
    
End Sub

Private Sub cmd_Change_Line_Click()

    '***Deklarationen
    Dim objWindows As Windows
    Dim objDoc As Document
    Dim strTyp As String
    Dim objSel As Object
    Dim dblLaenge As Double
    Dim dblSchritt As Double

    '***Fehlerroutine einschalten
     On Error GoTo Fehler

    '***Abfrage nach geöffnetem Dokument
    Set objWindows = CATIA.Windows
    If objWindows.Count = 0 Then
        MsgBox "Es ist kein Dokument geöffnet." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Kein Dokument offen"
        Exit Sub
    End If

    '***Auslesen der Dokumentart
    Set objDoc = CATIA.ActiveDocument
    strTyp = TypeName(objDoc)
    If strTyp <> "DrawingDocument" Then
        MsgBox "Dieses Dokument ist kein Drawing." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Falscher Dokumententyp"
        Exit Sub
    End If
    
    Set objSel = objDoc.Selection
    '***Vorselektion löschen um das Ergebnis nicht zu verfälschen
    objSel.Clear
    
    '***Performanceerhöhung der Suche
    CATIA.HSOSynchronized = False
    '***Element suchen
    objSel.Search "Drafting..Color='(" & intRot & "," & intGruen & "," & intBlau & ")' ;all"
    CATIA.HSOSynchronized = True
    
    If objSel.Count > 0 Then
        '***Fortschrittbalken einblenden
        Me.lbl_Fortschrittsbalken.Visible = True
        '***Startbreite des Fortschrittbalkens
        dblLaenge = 0
        '***Schrittbreite pro Aktualisierung
        dblSchritt = Me.lbl_Fortschrittsbalken.Width / objSel.Count
        For intI = 1 To objSel.Count
            '***Berechnung der Breite des Fortschrittbalkens
            dblLaenge = dblLaenge + dblSchritt
            Me.lbl_Fortschrittsbalken.Width = dblLaenge
            '***Berechung der Prozente für den Fortschrittstext
            Me.lbl_Fortschrittstext.Caption = Format(intI / objSel.Count, "0 %")
            
            '***Farbe über RGB definieren
            objSel.VisProperties.SetRealColor 0, 0, 0, 1
            '***Linienart definieren
            objSel.VisProperties.SetRealLineType 5, 0
        Next
        
        '***Meldung an User
        MsgBox "Makro wurde erfolgreich beendet.", vbInformation + vbOKOnly, "Makro erfolgreich beendet"
    Else
        MsgBox "Es ist keine Linie mit der definierten Farbe vorhanden.", vbExclamation + vbOKOnly, "Keine Linie vorhanden"
    End If
    
    objSel.Clear
    
    '***Fenster schließen
    Unload Me
    
Exit Sub

'***Fehlerbehandlung: Ausgabe der Fehlernummer und Fehlerbeschreibung
Fehler:
    MsgBox "Fehlernummer: " & Err.Number & vbNewLine & _
    "Fehlerbeschreibung: " & Err.Description, vbCritical + vbOKOnly, "Fehler"

End Sub

Private Sub UserForm_Initialize()

    '***ComboBox "Color" Initialwert festlegen
    Me.cmb_Color.Value = "Schwarz"

    '***ComboBox "Color" mit Werten füllen
    Me.cmb_Color.AddItem ("Schwarz")
    Me.cmb_Color.AddItem ("Rot")
    Me.cmb_Color.AddItem ("Grün")
    Me.cmb_Color.AddItem ("Blau")
    Me.cmb_Color.AddItem ("Gelb")
    Me.cmb_Color.AddItem ("Purpur")
    Me.cmb_Color.AddItem ("Blaugrün")
    Me.cmb_Color.AddItem ("Hellrot")
    Me.cmb_Color.AddItem ("Hellgrün")
    Me.cmb_Color.AddItem ("Hellblau")
    Me.cmb_Color.AddItem ("Hellgelb")
    Me.cmb_Color.AddItem ("Hellpurpur")
    Me.cmb_Color.AddItem ("Hellblaugrün")
    Me.cmb_Color.AddItem ("Pastellrot")
    Me.cmb_Color.AddItem ("Pastellgrün")
    Me.cmb_Color.AddItem ("Pastellblau")
    Me.cmb_Color.AddItem ("Chreme")
    Me.cmb_Color.AddItem ("Rosa")
    Me.cmb_Color.AddItem ("Babyblau")
    
    '***Fortschrittsbalken ausblenden
    Me.lbl_Fortschrittsbalken.Visible = False
    
End Sub
