Using VBA to turn off specific layers

[barakar42]

Hi,

 

I'm trying to write a small program to turn off selected layers using VBA. In our drawing, there are multiple layout tabs all called a unique name, e.g cxxx-e-000, cxxxx-e-001, cxxxx-e-002 etc etc.

 

These names also correspond to the layer name that they're assigned to, so drawing cxxxx-e-000 is on a layer called cxxxx-e-000

 

I have a list of drawings that are required and need to turn off all of the other layers.

 

So if we need drawings 000,001,005, we'd need to turn off layers 002,003,004 and all of the others

 

What would the best way to do it, would it be to turn off all the layers and then turn on select layers, or only turn off the un-neded layers?

 

kind regards

Chris

[PeterPan9720]

Hi,

question:

1) There are objects that need to be ON placed on layer 0 for example ? or any other layer not related to name indicated in the layout name ?.

I'm asking you this question because "ACTIVE LAYER" cannot be freezed.

2) Object on selected layer to be ON are similar ? all are blocks ? all are line or pline ?, all are text ?.

3) Object to turn off or on the correspondent layer are on PaperSpace or ModelSpace ?

 

Probably could be useful turn off all object on layers different from that indicated in the layout name.

Edited March 11, 2020 by PeterPan9720

[barakar42]

1. There will be no objects that are required to be on layer 0

2. Objects will mostly be lines and text

3. All the objects will be in model space

 

I've come up with some code that might work, but need you opinion on it

 

 

for a = 2 to 53 'total number of rows

set layerobj= ("B" & a) ' sets layer to first drawing

 

if ("E" & a) = true then    ' column E contains true or false

     set layerobj= ("B" & a+1)

      next a

else if  ("E" & a) = false then

     layerobj.layeron = false

           set layerobj= ("B" & a+1)

           next a

 

end if

 

 

 

 

[PeterPan9720]

Hi  barakar42, here a code that should work

It makes several loop, first around all layouts, second on layer name different from layout name.

Scope it's to maintain active all layers indicated in layout name.

Sub TestLayer()
    
    Set MyLayOuts = ThisDrawing.Layouts
    Set objLayer = ThisDrawing.Layers

For Each MyLayout In MyLayOuts
    If MyLayout.Name <> "Model" Then
      ThisDrawing.ActiveLayout = ThisDrawing.Layouts(MyLayout.Name)
        For Each MyLayer In objLayer
            If ActiveDocument.ActiveLayer.Name <> MyLayer.Name Then
                If MyLayer.Name <> MyLayout.Name Then
                    MyLayer.Freeze = True
                End If
            End If
        Next
    End If
Next
    ThisDrawing.Regen acAllViewports
    
End Sub

Try it should work, it's has been developed inside Autocad VBA ambient.

I don't understand your code, I'll check better. Are you using Excel ?

Edited March 11, 2020 by PeterPan9720

[barakar42]

Hi Peter,

 

I've tried your code and it's not wokring.

 

It comes up with the error object required on this line:

 

Set MyLayOuts = ThisDrawing.Layouts

 

 

Also, does your code work by freezing the layers if they match with the layout name and layer name?

[PeterPan9720]

3 minutes ago, barakar42 said:

Hi Peter,

 

I've tried your code and it's not working.

 

It comes up with the error object required on this line:

 

Set MyLayOuts = ThisDrawing.Layouts

 

 

Also, does your code work by freezing the layers if they match with the layout name and layer name?

 

On my computer works fine, check the reference libraries, are you using which Autocad version ?

"...Also, does your code work by freezing the layers if they match with the layout name and layer name?..."

No, exactly the opposite all layers different from layout name will be freezed, if I understand well your request.

[barakar42]

I've already got the AutoCAD 2019 type library selected in the reference lists

 

All of the layout and the layer names will be the same

 

layout                                   layer

cxxxx-e-000                         cxxxx-e-000

cxxxx-e-001                         cxxxx-e-001

cxxxx-e-002                         cxxxx-e-002

cxxxx-e-003                         cxxxx-e-003

etc                                         etc

 

it'll be best to either turn them all off and only turn on the required layers (true)

 

or

 

only turn off the layers that aren't required (false)

 

So using colums e we can see which layers will be required

[PeterPan9720]

Hi barakar42,

You never told us about excel, so you have a list of layers to be turn on and off in Excel, and you would like to use this in order to turn on & off layers inside drawing Model Space ?

Lists will be produced by your self ? it will be always the same ? I mean layer name in the same position ? TRUE or FALSE in the same position ?

In any case the best is to operate inside Autocad VBA pointing to Excel for layer list, and true or false option.

In the mean time code I gave you it's working ? or not.

I'll try to modify it in order to match with your request, please send me the excel file.

I already sent you sometime ago the way to have access to excel file by autocad VBA, it's working ?

[barakar42]

Hi Pete,

 

sorry for not mentioning that

Lists will be produced by the engineers and will only use the numbers that are within the excel document

There will be changes between each job that we do

The previous code you helped me with a while ago is working perfectly

 

I've put the code into module 10 as that will be the one that freezes/hides the layers

 

The previous code you've given me is in module 4

Copy of Copy of Copy of ACADTEST - Copy.xlsm

[PeterPan9720]

Hi,

the main issue concern that you are copy and paste a code developed for Autocad VBA inside Excel VBA, and of course it cannot work, I'll try to solve your issue.

VBA means Visual Basic for Application, so each application has own development tools, of course there are some way to point each other and exchange data, but what you are doing it's completely wrong copy and paste doesn't work anyway.

So your prefer to use excel as main workplace ? and press the button for cad.

 

I'll give you an answer soon.

 

[barakar42]

Excel will be the main tool and all the code will be withing Excel.

 

We will eventually have a program to create and issue drawings by using a Excel userform

 

For now, it's sorting out the layers that's the issue..

 

I didn't realise that there's a difference between AutoCAD VBA and Excel VBA

[PeterPan9720]

3 minutes ago, barakar42 said:

Excel will be the main tool and all the code will be withing Excel.

Answer: OK

We will eventually have a program to create and issue drawings by using a Excel userform

 

For now, it's sorting out the layers that's the issue..

 

I didn't realise that there's a difference between AutoCAD VBA and Excel VBA

Answer: Windows and all related software it's an operative system based on events, object, properties, and so on, of course objects available inside Autocad are different from objects created and used in Excel, in the same way developing tools are different. In any case I'll try to solve your issue from Excel side. 

Bye.

 

[PeterPan9720]

Hi please, could you give me a sample drawing with some objects on several layer ?, perhaps you can delete sensible information such as customer company name, etc.

It's just for testing procedure.

Thank you

[barakar42]

TEST VBA LAYER FILE.dwg

 

Here's a sample file with only 9 layers set up and a few lines on each layer

[PeterPan9720]

40 minutes ago, barakar42 said:

TEST VBA LAYER FILE.dwg 183.3 kB · 0 downloads

 

Here's a sample file with only 9 layers set up and a few lines on each layer

Thank you, but actually seems object are on layout not on Model Space area, and of course are exactly on the same layer named as layout.

I guess it will be on modelspace in the next future and transferred by viewport on PaperSpace Layout.

In any case, due to we are working on layer ON & OFF doesn't matter where objects are, if they are on OFF layer they will be not visible.

 

Please could you give an additional info ? TRUE means layer ON ? and FALSE means layer OFF ? It's correct ?

 

As second issue, I suggest to fix all drawing with layer 0 as default layer, because if active layer will be inserted inside the layer to be off, and you freeze the active layer you got an error.

However I'll try to modify your procedure.

I saw your drawing and there are still some duplicated attributes inside main title block, on the opposite as I suggested you several time ago.

I hope that part will work fine.

Edited March 11, 2020 by PeterPan9720

[PeterPan9720]

Hi,

Here attached your file with procedure modified.

Now you will work only on Excel side and of course on CAD for what concerning the drawing part.

There is a the first part of procedure that will check if Autocad is open or not, if not procedure open an empty dwg.

Best solution could be yuo open before your drawing, modify excel as required run procedure by excel command button.

The second part check the list of layer and compare with those inside the dwg and set on or off as per checked box 

Select layers to be on or off and press CAD Stuff, the check drawing you send me or other.

Sub Cad_Transfer()

    Dim AcadApp As Object
    Dim AcadDoc As Object
    
    'Check if AutoCAD application is open.
    On Error Resume Next
    Set AcadApp = GetObject(, "AutoCAD.Application")
 
    'If AutoCAD is not opened create a new instance and make it visible.
    If AcadApp Is Nothing Then
        Set AcadApp = CreateObject("AutoCAD.Application")
        AcadApp.Visible = True
    End If
 
    'Check (again) if there is an AutoCAD object.
    If AcadApp Is Nothing Then
        MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
        Exit Sub
    End If
    On Error GoTo 0
 
    'If there is no active drawing create a new one.
    On Error Resume Next
    Set AcadDoc = AcadApp.ActiveDocument
    If AcadDoc Is Nothing Then
        Set AcadDoc = AcadApp.Documents.Add
    End If
    On Error GoTo 0
 
    'Check if the active space is paper space and change it to model space.
    If AcadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
        AcadDoc.ActiveSpace = 1 '1 = acModelSpace in early binding
    End If
    
    'Retrive LayerList from Drawing
    Set ObjLayer = AcadDoc.Layers

    'Check last Cell where to find layer Name
    Range("B2").Select
    Selection.End(xlDown).Select
    MyAdd = Selection.Address
    
    'Check if layer shall be on or off

    For Each LayerName In Range("$B$2:" & MyAdd)
        MyRow = LayerName.Row
        MyCol = LayerName.Column
        Debug.Print Cells(MyRow, MyCol).Value

        LayerState = Cells(MyRow, MyCol + 3)
        
            For Each MyLayer In ObjLayer
                If MyLayer.Name <> AcadDoc.ActiveLayer.Name Then
                    If MyLayer.Name = LayerName And LayerState = True Then
                        MyLayer.Freeze = False
                    ElseIf MyLayer.Name = LayerName And LayerState = False Then
                        MyLayer.Freeze = True
                    End If
                End If
            Next
    Next
    
    AcadDoc.Regen acAllViewports
    Set AcadDoc = Nothing
    Set AcadApp = Nothing
        
    
End Sub

 

Copy of Copy of Copy of ACADTEST - Copy.xlsm

[barakar42]

All the objects will be in model space. 

The previous code you've given me had helped modify attributes 

 

We're working on putting all of the attributes within one block as you have suggested, but that's taking some time

 

I shall try out the code, thanks for your help again Peter 

[PeterPan9720]

Hi,

I modified little bit the procedure in order to set the current layer to "0" because in your drawing I saw sometime the current layer has been settled from those included in excel file to be turn off or on.

So here attached your excel file with Module 10 modified with the following parts:

Global AcadDoc As Object

Sub Cad_Transfer()

    Dim AcadApp As Object
    'Dim AcadDoc As Object ' MOVED AS GLOBAL VARIABLE DECLARATION

...

    MyAdd = Selection.Address
    Range("B2").Select 'After retriving last cell in the excel file, selection will be settled to top list cell.
    
    'Check if layer shall be on or off
    SetToLayer0 ' Added routine for setting layer "0" as current before settining ON OFF the layers listed in Ecel file.

....
'NEW ROUTINE
Sub SetToLayer0()
Dim MyLayer As AcadLayers
Set MyLayer = AcadDoc.Layers
i = 0
For Each CurrentLayer In MyLayer
    If CurrentLayer.Name = "0" And CurrentLayer.Name <> AcadDoc.ActiveLayer.Name Then
        AcadDoc.ActiveLayer = AcadDoc.Layers.Item(i)
    End If
i = i + 1
Next
End Sub

However again attached your excel file, please check module 10 VBA.

Command button on excel worksheet has been fixed pointing MODULE 10 procedure Cad_Transfer()

A final MsgBox at the end of layer setting ON OFF procedure could be added, in order to have a check of end of procedure.

Actually it's not provided, you can add to yourself.

Regards

Copy of Copy of Copy of ACADTEST - Copy.xlsm

[barakar42]

Peter,

 

This works perfectly, you are a genius!!!! 

[PeterPan9720]

1 minute ago, barakar42 said:

Peter,

 

This works perfectly, you are a genius!!!! 

Thank you,

I'll make a BIGGER print-out of your post and I'll give to my BOSS.

 

Please follow my suggestion about a title block.

 

Regards