Round 2...
Option Explicit
Public Sub FIXLAYERS()
Call DELETELAYERS
Call SETUPLAYERS
Call SETCOLORLINETYPE
Call CHANGELAYER
End Sub
This is the actual 'function' that we'll use (FIXLAYERS) that will call the other functions in the order shown
What follows is our first called sub-function (DELETELAYERS)
Private Sub DELETELAYERS()
Dim objLayer As AcadLayer
Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim n As Integer
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
Make layer '0' current
For Each objLayer In ThisDrawing.Layers
If objLayer.Name = "0" Then
objLayer.Lock = False
objLayer.LayerOn = True
'objLayer.Freeze = False
Else
objLayer.Lock = False
End If
Make sure that layer '0' is neither locked nor frozen and turn it on if need be. Make sure the rest of the layers in the drawing are unlocked, should they be locked.
Next
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
ThisDrawing.Application.Update
ThisDrawing.Regen acAllViewports
Okay... other than the Application.Update (what does that do anyway?) and the regen, didn't we already set layer '0' as current? Why are we doing it again?
For Each objLayer In ThisDrawing.Layers
If objLayer.LayerOn = False Then
If ThisDrawing.SelectionSets.Count > 0 Then
For n = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(n).Name = "layerdelete" Then
ThisDrawing.SelectionSets("layerdelete").Delete
End If
Next n
End If
Alright, I'll admit that I don't quite follow
exactly what's going on here... It seems like what you are doing is checking to see if a particular layer is off and, if it is, uhhh...
hmmmm... then what?
Set OBJSELSET = ThisDrawing.SelectionSets.Add("layerdelete")
OBJSELSET.Select acSelectionSetAll
For Each objSelected In OBJSELSET
If objSelected.Layer = objLayer.Name Then
objSelected.Delete
End If
Next
objLayer.Delete
End If
Next
Whoa! I
guess this is where we're taking all layers that are off and deleting them... but I can't say how we're doing that.
For Each objLayer In ThisDrawing.Layers
If objLayer.Freeze = True Then
If ThisDrawing.SelectionSets.Count > 0 Then
For n = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(n).Name = "layerdelete" Then
ThisDrawing.SelectionSets("layerdelete").Delete
End If
Next n
End If
Set OBJSELSET = ThisDrawing.SelectionSets.Add("layerdelete")
OBJSELSET.Select acSelectionSetAll
For Each objSelected In OBJSELSET
If objSelected.Layer = objLayer.Name Then
objSelected.Delete
End If
Next
objLayer.Delete
End If
Next
Same thing as the layers that are off, only this is dealing with the layers that are frozen. Still not sure about the process taking place though.
End Sub
This is the end of our first called sub-function (DELETELAYERS)
What follows is our second called sub-function (SETUPLAYERS)
Private Sub SETUPLAYERS()
Dim objLay As AcadLayer
Set objLay = ThisDrawing.Layers.Add("E-BASE-PLAN")
objLay.color = 252
End Sub
This is the end of our second called sub-function (SETUPLAYERS)
It creates a layer called E-BASE-PLAN and assigns it a color of 252
What follows is our third called sub-function (SETCOLORLINETYPE)
Private Sub SETCOLORLINETYPE()
Dim objLayer As AcadLayer
Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim n As Integer
If ThisDrawing.SelectionSets.Count > 0 Then
For n = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(n).Name = "changecolorline" Then
ThisDrawing.SelectionSets("changecolorline").Delete
End If
Next n
End If
Set OBJSELSET = ThisDrawing.SelectionSets.Add("changecolorline")
OBJSELSET.Select acSelectionSetAll
Ummm... same stuff, only different.
'this is where we are at so far
A comment!
End Sub
This is the end of our third called sub-function (SETCOLORLINETYPE)
What follows is our fourth called sub-function (CHANGELAYER)
Private Sub CHANGELAYER()
MsgBox "CHANGE LAYER"
End Sub
This is the end of fourth called sub-function (CHANGELAYER)
It pops up a MSGBOX that says "CHANGE LAYER"
How'd I do?
Hey! More code to go through!