Layer + linetype

[Shanskvm]

How to create new layer and with linet type?

How to write code ?

Thanks

shan

[Alfred.NESWADBA]

Hi,

may I introduce you to the VBA (for AutoCAD) -HELP 😉

you find there all objects and all methods/properties and for (nearly) all methods you have examples to take.

Look how I would solve your questions using the help within the video.

- alfred -

[Hallex]

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