Visio > User-submitted Stuff

Munsell Color Chart in Visio

(1/1)

JuneTheSecond:
I made a drawing for color chart.
It contains 125 Munsell color chart in the type of  drawing stencil.
All dropped masters on the Visio drawing has shape data
that has the data of color name, Munsell notation, RGB and CMYK notation.
To convert Munsell notation to sRGB I use the VBA functions made by
Maker-One(Ayahito_404NF) at http://www2.odn.ne.jp/~cdh88520/.
You can visit and download the file at the site, but written in Japanese.
Appropriate translator on line would help you.
The set of color name and Munsell notation is written in JIS standard.
It may be taken from ASTM standard.
Please enjoy the various colors.

aledlund:
an amazing implementation.
al

Paul Herber:
How many of us had to look up what Munsull colors were all about?
http://en.wikipedia.org/wiki/Munsell_color_system

aledlund:
I have to look-up most of what Junichi offers to the forum
 ;D
al

JuneTheSecond:
I think it's beter to write here the information about the VBA functions used in my drawing.
1.  VBA functions to convert color formats.
     Download url     http://maker-one.ddo.jp:8080/cdh88520/color_list_for_ww2fighters.html#a1
     File name   calc_color_vba_module_20100323.zip

2. Functions for calculating the Min, Max and StdDev
     url    http://www.visualbasic.happycodings.com/Applications-VBA/code8.html

And here is a set of my own macro that converts Munsell to RGB and CMYK.


--- Code: ---
Sub Munsell2RGB_CMYK(shp As Visio.Shape)

    Dim munsell As String
    Dim R As Double, G As Double, B As Double
    Dim C As Double, M As Double, Y As Double, K As Double
   
    munsell = shp.Cells("Prop.Munsell").ResultStr("")
   
'    Debug.Print munsell
    Munsell2sRGB munsell, R, G, B
'    Debug.Print "R, G, B", R, G, B
    shp.Cells("FillForegnd").Formula = "RGB(" & R & "," & G & "," & B & ")"
    shp.Cells("Prop.RGB").Formula = Chr(34) & R & " " & G & " " & B & Chr(34)
    RGB2CMYK R, G, B, C, M, Y, K
'    Debug.Print C, "/", M, "/", Y, "/", K
    shp.Cells("Prop.CMYK").Formula = Chr(34) & C & " " & M & " " & Y & " " & K & Chr(34)
   
End Sub

Sub Munsell2sRGB(munsell As String, R As Double, G As Double, B As Double)
'    Dim munsell As String
    Dim sx As Double
    Dim sy As Double
    Dim LY As Double
    Dim LLX As Double
    Dim LLY As Double
    Dim LLZ As Double
    Dim Rs As Double
    Dim Gs As Double
    Dim Bs As Double

    sx = m2val(munsell, "x")
    sy = m2val(munsell, "y")
    LY = m2val(munsell, "Y")
   
'    Debug.Print "sx, sy, LY", sx, sy, LY
   
    LLX = xylY2lX(sx, sy, LY) / 100#
    LLY = LY / 100#
    LLZ = xylY2lZ(sx, sy, LY) / 100#
   
'    Debug.Print "LLX, LLY, LLZ", LLX, LLY, LLZ
   
    Rs = lXlYlZ2Rds(LLX, LLY, LLZ)
    Gs = lXlYlZ2Gds(LLX, LLY, LLZ)
    Bs = lXlYlZ2Bds(LLX, LLY, LLZ)
   
    If Left(munsell, 1) = "N" Or Right(munsell, 2) = "/0" Then
        Rs = Average(Rs, Gs, Bs)
        Gs = Rs
        Bs = Rs
    End If

'    Debug.Print "Rs, Gs, Bs", Rs, Gs, Bs
   
    R = Rs * 255
    G = Gs * 255
    B = Bs * 255
   
    R = Round(R)
    G = Round(G)
    B = Round(B)
   
'    Debug.Print "R, G, B", R, G, B
End Sub


Sub RGB2CMYK(R As Double, G As Double, B As Double, C As Double, M As Double, Y As Double, K As Double)
    K = Min(1 - R / 255, 1 - G / 255, 1 - B / 255)
    If (K = 1) Then
        C = 0
        M = 0
        Y = 0
    Else
        C = (1 - R / 255 - K) / (1 - K)
        M = (1 - G / 255 - K) / (1 - K)
        Y = (1 - B / 255 - K) / (1 - K)
    End If
    C = Round(C * 100)
    M = Round(M * 100)
    Y = Round(Y * 100)
    K = Round(K * 100)

End Sub


--- End code ---

And here is a macro that changes the name of master to the color name.


--- Code: ---
Sub AddNameOnMaster(shp As Visio.Shape)
    shp.Master.Name = shp.Cells("Prop.Name").ResultStr("")
End Sub


--- End code ---

Navigation

[0] Message Index