Für Projekte kann es notwendig sein, dass man die in allen Zeichnungen verwendeten Farbtabellen nach RGB Werten in Textdateien auswerten möchte.VBA bietet die Möglichkeit an, direkt auf alle Farben zuzugreifen. Jeder einzelne Farbwert wird als Long abgespeichert, so dass die RGB Werte einzeln asugelesen werden können.Hier dazu ein Beispiel, das alle Werte der aktuellen Farbtabelle ausliest. Die Ausgabe erfolgt in eine CSV Datei, die im selben Verzeichnis wie die geöffnete Zeichnung abgelegt wird:
' Convert Long to RGB Values Private Sub ExtractRGB(ByVal longColor As Long, intRed As Byte, intGreen As Byte, intBlue As Byte) Dim lngColor As Long lngColor = longColor intRed = lngColor Mod &H100 lngColor = lngColor \ &H100 intGreen = lngColor Mod &H100 lngColor = lngColor \ &H100 intBlue = lngColor Mod &H100 End Sub ' extract colors from attached colortable Sub tbl2txt() Dim tbl As ColorTable Dim col() As Long Dim r As Byte, g As Byte, b As Byte Dim bg As Long Set tbl = ActiveDesignFile.ExtractColorTable col = tbl.GetColors Open ActiveDesignFile.FullName + "-rgb values.csv" For Output As #1 Print #1, "Number;Red;Green;Blue" For i = LBound(col) To UBound(col) Call ExtractRGB(col(i), r, g, b) Print #1, Str(i) + ";" + Str(r) + ";" + Str(g) + ";" + Str(b) Next ' and Background color: bg = tbl.BackColor Call ExtractRGB(bg, r, g, b) Print #1, "BG;" + Str(r) + "; " + Str(g) + "; " + Str(b); "" Close #1 End Sub
Zum Erstellen der CSV Datei muss die Subroutine tbl2txt aufgerufen werden
Ein Ausschnitt der Ausgabe in der .csv kann dann beispielsweise so aussehen:
.......
Es lassen sich die Daten dieser CSV Datei auch leicht wieder in eine Farbtabelle einer Zeichnung zurückschreiben.Dazu habe ich folgendes Beispiel txt2tbl zusammengestellt, das die mit der Routine tbl.txt erstellte CSV Datei in die aktuell geöffnete Zeichnung einliest.
Damit können Änderungen an einer Farbtabelle auch außerhalb von MIcroStation durchführen.Fügen Sie dieses Beispiel in das vorhandene Projekt hinzu:
Sub txt2tbl() Dim cTbl As ColorTable Dim col() As Long Dim r As Byte, g As Byte, b As Byte Dim bg As Long Dim Sep As String Dim sZeile As String Dim s() As String ' das Trennzeichen bei .CSV Dateien festlegen, abhängig von den Regionaleinstellungen: Sep = ";" Set cTbl = ActiveDesignFile.ExtractColorTable Open ActiveDesignFile.FullName + "-rgb values.csv" For Input As #1 Do While Not EOF(1) Line Input #1, sZeile s = Split(sZeile, Sep) If (UBound(s) - LBound(s) = 3) And Trim(s(LBound(s))) <> "Number" Then If Trim(s(0)) = "BG" Then cTbl.BackColor = RGB(Val(s(1)), Val(s(2)), Val(s(3))) Else cTbl.SetColorAtIndex Val(s(0)), RGB(Val(s(1)), Val(s(2)), Val(s(3))) End If End If Loop ActiveDesignFile.AttachColorTable cTbl End Sub