Found in my oldies
Option Explicit
'----------------------------------------------------------
' Function to determine if a layer exists
'----------------------------------------------------------
' **** Kusleika's method
Public Function LayerExists(lyrName As String) As Boolean
Dim oLayer As AcadLayer
On Error Resume Next
Set oLayer = ThisDrawing.Layers(lyrName)
LayerExists = (Err.Number = 0)
End Function
'----------------------------------------------------------
' Function to determine if a linetype exists
'----------------------------------------------------------
' **** Kusleika's method
Public Function LineTypeExists(ltpName As String) As Boolean
Dim oLineType As AcadLineType
On Error Resume Next
Set oLineType = ThisDrawing.Linetypes(ltpName)
LineTypeExists = (Err.Number = 0)
End Function
'----------------------------------------------------------
' Function to set an existing layer or create a new drawing layer
'----------------------------------------------------------
Function AddLayer(layerName As String, ltpName As String, intColor As Long, intLweight As Integer, strDesc As String, Optional blnPlot = True) As AcadLayer
Dim oLayer As AcadLayer
With ThisDrawing
Dim strVer As String
strVer = "AutoCAD.AcCmColor." + Left(CStr(.GetVariable("ACADVER")), 2)
Dim acmColor As AcadAcCmColor
Set acmColor = AcadApplication.GetInterfaceObject(strVer)
acmColor.ColorIndex = intColor
' Add the layer to the layers collection
Set oLayer = .Layers.Add(layerName)
On Error Resume Next
If Not LineTypeExists(ltpName) Then
If .GetVariable("MEASUREINIT") = 0 Then
.Linetypes.Load ltpName, "acad.lin"
Else
.Linetypes.Load ltpName, "acadiso.lin"
End If
End If
oLayer.Linetype = ltpName
oLayer.Lineweight = intLweight
oLayer.TrueColor = acmColor
' Put plottable if does not defined in the calling function
If Not blnPlot Then
oLayer.Plottable = Not oLayer.Plottable
oLayer.Plottable = blnPlot
End If
' Put description
oLayer.Description = strDesc
' Make the new layer the active layer for the drawing
.ActiveLayer = oLayer
End With
Set acmColor = Nothing
Set AddLayer = oLayer
End Function
Sub bb()
Call AddLayer("ALAYER", "DASHDOT2", 162, 60, "My description")
End Sub
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
