Function CreateLayer(ByVal namelayer As String, ByVal R, G, B As Double)
 
 
 
	'****************************************
 
	'*** Code from VisibleVisual.com ********
 
	'****************************************
 
 
 
	On Error Resume Next
 
 
 
	Dim color As AcadAcCmColor
 
	Dim newlayer As AcadLayer
 
 
 
	'Select Layer or if not exists create a new layer
 
	Set newlayer = ThisDrawing.Layers.Add(namelayer)
 
	If Err > 0 Then
 
	Set newlayer = ThisDrawing.Layers.Item(namelayer)
 
	Err.Clear
 
	End If
 
 
 
	'Set AutoCAD Color Objects
 
	If Left(AutoCAD.Application.ActiveDocument.GetVariable("acadver"), 2) = "16" Then
 
	Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
 
	ElseIf Left(AutoCAD.Application.ActiveDocument.GetVariable("acadver"), 2) = "17" Then
 
	Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.17")
 
	Else
 
	MsgBox "Wrong Autocad version fro this function"
 
	Exit Function
 
	End If
 
 
 
	'R,B,G stands for Red, Green, Blue value
 
	Call color.SetRGB(R, G, B)
 
 
 
	'Create a Layer and make it the active layer
 
	newlayer.TrueColor = color
 
	ThisDrawing.ActiveLayer = newlayer
 
 
 
	End Function