---

Hallo zusammen,
ich habe da mal ein ganz kleines Problem. Ich suche nach einer Möglichkeit Teile mit RGB Farben zu versehen. Leider sind es ca. 2000 und es werden immer mehr   . Ich habe lediglich eine Exceltabelle mit Materialnummern zur Verfügung. Nun würde ich diese gerne dazu missbrauchen mittels Macro einen Lauf über diese Dokumente zu machen, nachzuschauen, was für ein Werkstoff ist hinterlegt, die Datei zu öffnen und die werkstoffspeziefische Farbe (z.B. für A3C)dem Modell zuzuordnen, zu speichern und dann die nächste zu suchen z.B. aus Alu etc.
Hat schon mal jemand in der Form  sowas gemacht?
Kann ich ein Excelsheet überhaupt so unmittelbar verwurschteln oder brauch ich eine Commadatei?

Danke fürŽs lesen, hoffentlich hab ich mich einigermaßen verständlich ausgedrückt 

------------------
Grüße von der Saar
Uwe Blum

www.hydac.com/

[Diese Nachricht wurde von ublum am 20. Jun. 2005 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Uwe

mein Ansatz wäre:

Ausführung mit Programm SW_pac (SW_tools)

- Dateien Indentifizieren (manuell / folder)
- Dannach Entfärbenmakro (S. Berlitz)

Bin aber auch alles andere als ein speziallist für solche aufgaben.
Aber bevor keiner Antwortet...

Gruß Alex

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Uwe

ich habe bei uns in der Firma so eine automatische Farbzuweisung beim eintragen der Dateieigenschaften verwirklicht. Nachfolgend ein auszug betreffend der Farbzuweisung aus dem Programm, die Daten werden aus einer Exceltabbelle gelesen.

Sub barModellfarbe()
   
    Dim SWXMatPropArray As Variant
    Dim SWXMatProp(8) As Double
    Dim ret As Boolean
    Dim swApp As Object
    Dim Model As Object
    Dim Zähler As Integer
    Dim Index As String
    Dim SpalteB As Variant
    Dim SpalteD As Variant
    Dim SpalteE As Variant
    Dim SpalteF As Variant
    Dim ExcelApp As Object
    Dim wkbObj As Object
   
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = False
    Set wkbObj = ExcelApp.Workbooks.Open(App.Path & "\" & "Dateieigenschaften.xls", , True)
   
    Set swApp = CreateObject("SldWorks.Application")
    Set Model = swApp.ActiveDoc
   
    If (Model.GetType() = swDocASSEMBLY) = True Then
            ExcelApp.Quit
            Set ExcelApp = Nothing
            Exit Sub
    End If
   
    If cmbWerkstoff_klein.Text = "." Or Empty Then
        ExcelApp.Quit
        Set ExcelApp = Nothing
        Exit Sub
    End If
   
    Teilfarbe = Model.CustomInfo("Werkstoff (klein)")
   
    If Teilfarbe = cmbWerkstoff_klein.Text Then
        Mldg = "Soll dem Modell die Standardfarbe neu zugewiesen werden ?"
        Stil = vbYesNo + vbQuestion + vbDefaultButton2
        Titel = "Farbzuweisung"
        Antwort = MsgBox(Mldg, Stil, Titel)
            If Antwort = vbNo Then
                ExcelApp.Quit
                Set ExcelApp = Nothing
                Exit Sub
            End If
    End If

        Zähler = 0
        Index = False
       
        Do
        Zähler = Zähler + 1
        SpalteB = wkbObj.Worksheets(1).Range("B" & Zähler + 1).Value
        SpalteD = wkbObj.Worksheets(1).Range("D" & Zähler + 1).Value
        SpalteE = wkbObj.Worksheets(1).Range("E" & Zähler + 1).Value
        SpalteF = wkbObj.Worksheets(1).Range("F" & Zähler + 1).Value
       
        If SpalteB = Empty Then
            ExcelApp.Quit
            Set ExcelApp = Nothing
            Exit Sub
        End If
   
        If cmbWerkstoff_klein.Text = SpalteB = True Then
     
            ' Die übergebenen Werte sind Doubles von 0-1, werden umgerechnet von
            ' vorhandenen INT-Werte. Das sind die namen der Variablen.
            ' red - blue gehen von 0 - 255, Ambient bis Emission von 0 - 100
            ' ACHTUNG: um ein Safearray an SolidWorks zu übergeben muss eine Umformatierung
            '          in das Safearray erfolgen siehe API-Dokumentation
            SWXMatProp(0) = CDbl(SpalteD / 255)      'rot
            SWXMatProp(1) = CDbl(SpalteE / 255)    'grün
            SWXMatProp(2) = CDbl(SpalteF / 255)    'blau
            SWXMatProp(3) = CDbl(100 / 100)    'Ambient
            SWXMatProp(4) = CDbl(100 / 100)    'Diffuse
            SWXMatProp(5) = CDbl(100 / 100)    'Specular
            SWXMatProp(6) = CDbl(31 / 100)      'Shininess
            SWXMatProp(7) = CDbl(0 / 100)      'Transparency
            SWXMatProp(8) = CDbl(0 / 100)      'Emission
            ' hier die entscheidende Umwandlung in ein SafeArray (Variant)
            SWXMatPropArray = SWXMatProp
   
            Model.MaterialPropertyValues = (SWXMatPropArray)
            Index = True
            ExcelApp.Quit
            Set ExcelApp = Nothing
            Exit Sub
        End If
               
    Loop
   
End Sub

Ich hoffe das ich dir noch Helfen konnte und es nicht zuspät für dich ist.

Gruß Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
mehr als 10 UŽs gehen leider nicht 

Zitat:

---

Original erstellt von Ralf Blokscha:
ich dir noch Helfen konnte und es nicht zuspät für dich ist.

---

Zu spät   ?
So muss ein Tag beginnen      .
Vielen Dank

------------------
Grüße von der Saar
Uwe Blum

www.hydac.com/

[Diese Nachricht wurde von ublum am 22. Jun. 2005 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP