Create new layer in AutoCad using excel VBA

[Anonymous]

Hello to everyone,

I have a problem creating a new layer from excel VBA.

This is the code. Last if statements is wrong.

Sub New_Layer()

Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument

Dim newLayer As AcadLayer
Dim layerName As String


'Check if AutoCAD is open.
On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
    

    'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
    Set acadApp = New AcadApplication
    acadApp.Visible = True
End If

    'Check if there is an active drawing.
On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0

    'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
    acadApp.Visible = True
End If

'check to see if layer already exists and if not make a new

On Error Resume Next
    layerName = "Layer_1"
    Set newLayer = ThisDrawing.Layers.Add(layerName)
    newLayer.Color = acBlue
On Error GoTo 0

If newLayer Is Nothing Then
    Set newLayer = ThisDrawing.Layers.Add(layerName) 'Here I have error Object required
End If




End Sub

If someone can help me I will be very appreciative.

[Anonymous]

Hello to everyone,

I have a problem creating a new layer from excel VBA.

This is the code. Last if statements is wrong.

Sub New_Layer()

Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument

Dim newLayer As AcadLayer
Dim layerName As String


'Check if AutoCAD is open.
On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
    

    'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
    Set acadApp = New AcadApplication
    acadApp.Visible = True
End If

    'Check if there is an active drawing.
On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0

    'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
    acadApp.Visible = True
End If

'check to see if layer already exists and if not make a new

On Error Resume Next
    layerName = "Layer_1"
    Set newLayer = ThisDrawing.Layers.Add(layerName)
    newLayer.Color = acBlue
On Error GoTo 0

If newLayer Is Nothing Then
    Set newLayer = ThisDrawing.Layers.Add(layerName) 'Here I have error Object required
End If




End Sub

If someone can help me I will be very appreciative.

[Anonymous · Accepted solution]

Solved!!!

Sub New_Layer()

Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument

Dim newLayer As AcadLayer
Dim layerName As String


'Check if AutoCAD is open.
On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
    

    'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
    Set acadApp = New AcadApplication
    acadApp.Visible = True
End If

    'Check if there is an active drawing.
On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0

    'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
    acadApp.Visible = True
End If

'check to see if layer already exists and if not make a new

On Error Resume Next
    layerName = "Layer_1"
    Set newLayer = acadDoc.Layers.Add(layerName)
    newLayer.Color = acBlue
On Error GoTo 0

If newLayer Is Nothing Then
    Set newLayer = acadDoc.Layers.Add(layerName)
End If
acadDoc.ActiveLayer = newLayer



End Sub

[Anonymous · Accepted solution]

Solved!!!

Sub New_Layer()

Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument

Dim newLayer As AcadLayer
Dim layerName As String


'Check if AutoCAD is open.
On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
    

    'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
    Set acadApp = New AcadApplication
    acadApp.Visible = True
End If

    'Check if there is an active drawing.
On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0

    'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
    acadApp.Visible = True
End If

'check to see if layer already exists and if not make a new

On Error Resume Next
    layerName = "Layer_1"
    Set newLayer = acadDoc.Layers.Add(layerName)
    newLayer.Color = acBlue
On Error GoTo 0

If newLayer Is Nothing Then
    Set newLayer = acadDoc.Layers.Add(layerName)
End If
acadDoc.ActiveLayer = newLayer



End Sub

[cheryl.buck]

Hi @Anonymous,

Thank you for returning and adding a post with the Solution.   

Please select the Accept as Solution button on your post so other members of the community can more easily find the solution.

All the best.

[cheryl.buck]

Hi @Anonymous,

Thank you for returning and adding a post with the Solution.   

Please select the Accept as Solution button on your post so other members of the community can more easily find the solution.

All the best.

[ahmedmontaser504]

I want acode that make layer isolate to active layer

[ahmedmontaser504]

I want acode that make layer isolate to active layer

[pendean]

---

@ahmedmontaser504 wrote:
I want acode that make layer isolate to active layer

---

https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-E24B9866-9538-43BF-A3DF-AA7E2341C624

[pendean]

---

@ahmedmontaser504 wrote:
I want acode that make layer isolate to active layer

---

https://help.autodesk.com/view/ACD/2022/ENU/?guid=GUID-E24B9866-9538-43BF-A3DF-AA7E2341C624