[编程交流] 使用设置图层颜色

Function CreateLayer(ByVal namelayer As String, ByVal R, G, B As Double)
   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")
   
   ElseIf Left(AutoCAD.Application.ActiveDocument.GetVariable("acadver"), 2) = "19" Then
   Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.19")
   Else
   MsgBox "Wrong Autocad version for 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