Author Topic: Convert all to BYLAYER  (Read 19191 times)

0 Members and 1 Guest are viewing this topic.

nivuahc

  • Guest
Convert all to BYLAYER
« on: February 01, 2006, 10:22:04 AM »
Okay, here's what I've got in VBA. I didn't write this by myself, I had lots of help ( a few years ago). I can't even explain everything that's going on with this code (I mean, sure, I have the general idea... I can read the code and see what's happening.) so I can't tell you why something is the way that it is. What I'm wanting to do is make this better.

What I use it for: When we get a composite plan from an architect we usually have to run this on it in order to 'fix' the drawing so that all of the items in the drawing are set to BYLAYER. Then it changes all of the layers in the drawing to color 252 so we can use it as a base plan.

Right now, it works, but it's very slow (especially on large drawings) and it changes the color of layer '0' and layer 'Defpoints' (if it exists) to color 252. It also, for some reason I am unaware of, fails to get some attributes and it also fails to change nested blocks. And, it occasionally skips dimensions altogether. Once the basics of the routine are done it performs a purge that almost purges everything out of the drawing.

I know this can be better. I just don't know how to make it so. I'd also like to do something a bit different but I don't have a clue when it comes to VBA.

What I'd like to see it do: I'd like to take each and every entity in the drawing and find out what linetype it is. If it's 'BYLAYER' then find out what linetype is assigned to that layer. Change the entity to that linetype (yes, I know) and, when done, change the layer of each entity to a single layer (i.e. E-BASE-PLAN), retaining the original linetype. In the case of frozen layers or layers that are turned off, those items 'not shown' are useless to me, so they should be discarded completely. When complete, there should be 2 layers in the drawing; '0' and 'E-BASE-PLAN' and each entity should have it's color set to 'BYLAYER' and it's linetype set to whatever.

I was going to try to tackle this in LISP but I am so 'under the gun' at work I haven't had any time to devote to it.

Code: [Select]
Option Explicit

Sub dwgfix()
Call Set2Bylayer
Call FixBlocks
Call SetLayers
Call DoAtts
ThisDrawing.PurgeAll
End Sub

Sub Set2Bylayer()
On Error Resume Next
Dim ObjEnt As AcadEntity

' use current drawing
With ThisDrawing
' set active layer
.ActiveLayer.Name = "0"
.Application.Update
' change all entities in model space to color bylayer and lineweight bylayer (includes frozen)
For Each ObjEnt In .ModelSpace
'check if the layer is locked, if it is unlock it
If .Layers.Item(ObjEnt.Layer).Lock = True Then
   .Layers.Item(ObjEnt.Layer).Lock = False
   ObjEnt.Color = acByLayer
   ObjEnt.Lineweight = acLnWtByLayer
   ObjEnt.Update
'then lock it back so as to not change the layer state
   .Layers.Item(ObjEnt.Layer).Lock = True
Else
   ObjEnt.Color = acByLayer
   ObjEnt.Lineweight = acLnWtByLayer
   ObjEnt.Update
End If
Next
End With
End Sub


Sub FixBlocks()
' Redefines all blocks in a drawing to have property values of
' color & linweight bylayer
Dim blockObj As AcadBlock
Dim i As Long

For Each blockObj In ThisDrawing.Blocks
On Error Resume Next
For i = 0 To blockObj.Count - 1
'check if the layer is locked, if it is unlock it
If ThisDrawing.Layers.Item(blockObj.Item(i).Layer).Lock = True Then
   ThisDrawing.Layers.Item(blockObj.Item(i).Layer).Lock = False
    blockObj.Item(i).Color = acByLayer
    blockObj.Item(i).Lineweight = acLnWtByLayer
'then lock it back so as to not change the layer state
   ThisDrawing.Layers.Item(blockObj.Item(i).Layer).Lock = True
Else
    blockObj.Item(i).Color = acByLayer
    blockObj.Item(i).Lineweight = acLnWtByLayer
End If
Next i
Next blockObj
End Sub

Sub SetLayers()
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
objLayer.Color = 252
objLayer.Lineweight = acLnWtByLwDefault
Next
End Sub

Sub DoAtts()
Dim AllAtts As Variant
Dim Att As AcadAttributeReference
Dim SelSet As AcadSelectionSet
Dim BlockEnt As AcadBlockReference
Dim X As Long
Dim GCode As Variant
Dim GData As Variant
Dim Code(0) As Integer
Dim Data(0) As Variant

Code(0) = 0
Data(0) = "INSERT"

GCode = Code
GData = Data

On Error GoTo BlockError
Set SelSet = ThisDrawing.SelectionSets.Add("Blocks")
SelSet.Select acSelectionSetAll, , , GCode, GData
SelSet.Select acSelectionSetAll, , , 0, "INSERT"

On Error Resume Next
For Each BlockEnt In SelSet
If BlockEnt.HasAttributes Then
   AllAtts = BlockEnt.GetAttributes
   For X = 0 To UBound(AllAtts)
     Set Att = AllAtts(X)
     Att.Layer = "0"
     Att.Color = acByLayer
   Next X
End If
Next BlockEnt

BlockError:
ThisDrawing.SelectionSets.Item("Blocks").Delete
End Sub


David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #1 on: February 01, 2006, 10:27:32 AM »
This should be pretty easy to do.  What kind of time frame do you have?
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #2 on: February 01, 2006, 10:28:28 AM »
This is what I have we can work with
Code: [Select]
Public Sub Vendor()
    Dim objLay As AcadLayer
    Dim ENT As AcadEntity, objText As AcadText, objMText As AcadMText, objRotDim As AcadDimRotated

    On Error Resume Next
    Set objLay = ThisDrawing.Layers.Add("VNDR-THIN")
    objLay.color = 8
    Set objLay = ThisDrawing.Layers.Add("VNDR-TEXT")
    objLay.color = 80

    For Each ENT In ThisDrawing.ModelSpace
        Select Case ENT.ObjectName
            Case "AcDbText"
                ENT.Layer = "VNDR-TEXT"
            Case "AcDbMText"
                ENT.Layer = "VNDR-TEXT"
            Case "AcDbRotatedDimension"
                ENT.Layer = "VNDR-TEXT"
            Case Else
                ENT.Layer = "VNDR-THIN"
        End Select



    Next ENT


    ThisDrawing.Regen acAllViewports
End Sub

Public Sub Everythingbylayer()

Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim N As Integer

On Error Resume Next

If ThisDrawing.SelectionSets.Count > 0 Then
    For N = 0 To ThisDrawing.SelectionSets.Count - 1
        If ThisDrawing.SelectionSets.Item(N).Name = "EBL" Then
        ThisDrawing.SelectionSets("EBL").Delete
        End If
    Next N
End If

Set OBJSELSET = ThisDrawing.SelectionSets.Add("EBL")
OBJSELSET.Select acSelectionSetAll

For Each objSelected In OBJSELSET
objSelected.color = acByLayer
objSelected.Linetype = "ByLayer"
objSelected.Lineweight = acLnWtByLayer
objSelected.Update
Next

ThisDrawing.SelectionSets.Item("EBL").Delete
ZoomExtents
ThisDrawing.Application.Update
Exit_Here:
Exit Sub
End Sub
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #3 on: February 01, 2006, 10:49:46 AM »
so im thinking you want to
  • Unlock all layers
  • Delete all layers FROZEN and/or OFF
  • create the layers you need (E-BASE-PLAN)
  • Set colors to layers you are keeping
  • For each object in mspace, get layer, get linetype of layer, set linetype to object
  • Put each object on E-BASE-PLAN
« Last Edit: February 01, 2006, 10:56:28 AM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

nivuahc

  • Guest
Re: Convert all to BYLAYER
« Reply #4 on: February 01, 2006, 10:52:48 AM »
This should be pretty easy to do.  What kind of time frame do you have?

If, by time frame you mean "how much time do you have available to devote to this?"...

Not much. :( I'm buried under a pile of drawings right now and there is no real end in sight.

If, by time frame you man "how quickly are you looking for a solution?"...

There is no time frame. I'm not being pressured to make this, this would just make a lot of what I'm doing right now easier, thereby freeing up some of my time.

I'm willing to learn, though I can't promise stellar results when it comes to VBA (I've tried before but always get pulled in another direction so quickly forget what it was that I learned).

I'm looking at the code you posted above right now and attempting to make sense of it. As soon as I get finished, I'll post back here and tell you what I think it does. That should give you and idea about where I stand with VBA :D

so im thinking you want to
  • Delete all layers frozen and or off
  • create the layers you need (E-BASE-PLAN)
  • Set colors to layers you are keeping
  • For each object in mspace, get layer, get linetype of layer, set linetype to object
  • Put each object on E-BASE-PLAN

Precisely :)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #5 on: February 01, 2006, 10:55:31 AM »
If, by time frame you man "how quickly are you looking for a solution?"...
There is no time frame.
Excellent, then we have us a project with an open end date, so we can dial it in just the way you want it.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

nivuahc

  • Guest
Re: Convert all to BYLAYER
« Reply #6 on: February 01, 2006, 11:21:08 AM »
Okie doke, here is my attempt to "break it down, now"


Code: [Select]
Public Sub Vendor()
    Dim objLay As AcadLayer
    Dim ENT As AcadEntity, objText As AcadText, objMText As AcadMText, objRotDim As AcadDimRotated

    On Error Resume Next
    Set objLay = ThisDrawing.Layers.Add("VNDR-THIN")
    objLay.color = 8
    Set objLay = ThisDrawing.Layers.Add("VNDR-TEXT")
    objLay.color = 80

Create two layers. One called VNDR-THIN, color 8, and one called VNDR-TEXT, color 80.

Code: [Select]
    For Each ENT In ThisDrawing.ModelSpace
        Select Case ENT.ObjectName
            Case "AcDbText"
                ENT.Layer = "VNDR-TEXT"
            Case "AcDbMText"
                ENT.Layer = "VNDR-TEXT"
            Case "AcDbRotatedDimension"
                ENT.Layer = "VNDR-TEXT"
            Case Else
                ENT.Layer = "VNDR-THIN"
        End Select



    Next ENT

For each entity on the drawing change it to layer VNDR-TEXT if it is text, mtext or rotated dimensions?

Code: [Select]
    ThisDrawing.Regen acAllViewports
End Sub

Regen! :)

Code: [Select]
Public Sub Everythingbylayer()

Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim N As Integer

On Error Resume Next

If ThisDrawing.SelectionSets.Count > 0 Then
    For N = 0 To ThisDrawing.SelectionSets.Count - 1
        If ThisDrawing.SelectionSets.Item(N).Name = "EBL" Then
        ThisDrawing.SelectionSets("EBL").Delete
        End If
    Next N
End If

EBL? I presume that's short for Everything By Layer but, I admit, I have no idea what you're doing with it there. Are you looking for a named selection set and deleting it if it exists? Named selection set? Huh? Is that akin to creating a variable with LISP? (i.e. (setq EBL (ssget "x")) )

Code: [Select]
Set OBJSELSET = ThisDrawing.SelectionSets.Add("EBL")
OBJSELSET.Select acSelectionSetAll

hmmmm... probably. And I'm guessing that this creates said selection set and selects "all"

Code: [Select]
For Each objSelected In OBJSELSET
objSelected.color = acByLayer
objSelected.Linetype = "ByLayer"
objSelected.Lineweight = acLnWtByLayer
objSelected.Update
Next

ThisDrawing.SelectionSets.Item("EBL").Delete
Change all colors, linetypes and lineweights to "BYLAYER" then delete the created (named) selection set (EBL)

Code: [Select]
ZoomExtents
Now that's a real head scratcher ;)

Code: [Select]
ThisDrawing.Application.Update
Exit_Here:
Exit Sub
End Sub

Wrap it all up and we're done.

How was that?

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #7 on: February 01, 2006, 11:33:52 AM »
awsome!!! you can do this!  I have got the next part for you as well
Code: [Select]
Option Explicit

Public Sub FIXLAYERS()
    Call DELETELAYERS
    Call SETUPLAYERS
    Call SETCOLORLINETYPE
    Call CHANGELAYER
End Sub


Private Sub DELETELAYERS()
Dim objLayer As AcadLayer
Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim n As Integer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
    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
    Next
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
    ThisDrawing.Application.Update
    ThisDrawing.Regen acAllViewports

    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

            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
   
   
    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

End Sub

Private Sub SETUPLAYERS()
Dim objLay As AcadLayer
    Set objLay = ThisDrawing.Layers.Add("E-BASE-PLAN")
    objLay.color = 252
End Sub

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
'this is where we are at so far

End Sub

Private Sub CHANGELAYER()
    MsgBox "CHANGE LAYER"
End Sub
« Last Edit: February 01, 2006, 11:40:52 AM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #8 on: February 01, 2006, 11:36:22 AM »
At this point you will see some 'repeating' type code, Im trying to get you some concept code that works, we can make it pretty later.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

ronjonp

  • Needs a day job
  • Posts: 7524
Re: Convert all to BYLAYER
« Reply #9 on: February 01, 2006, 12:53:41 PM »
Here is a lisp variant of setting all objects in a drawing to bylayer...brought to you by resident code master MP. :)

http://www.theswamp.org/forum/index.php?topic=3020.msg37746#msg37746

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #10 on: February 01, 2006, 01:23:32 PM »
This is mostly where you want to be
Code: [Select]
Option Explicit

Public Sub FIXLAYERS()
    Call DELETELAYERS
    Call SETUPLAYERS
    Call SETCOLORLINETYPE
    Call CHANGELAYER
End Sub


Private Sub DELETELAYERS()
Dim objLayer As AcadLayer
Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim n As Integer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
    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
    Next
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
    ThisDrawing.Application.Update
    ThisDrawing.Regen acAllViewports

    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

            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
ThisDrawing.SelectionSets("layerdelete").Delete

    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

End Sub

Private Sub SETUPLAYERS()
Dim objLay As AcadLayer
    Set objLay = ThisDrawing.Layers.Add("E-BASE-PLAN")
    objLay.color = 252
End Sub

Private Sub SETCOLORLINETYPE()

Dim objLayer As AcadLayer
Dim objSelected As Object
Dim OBJSELSET As AcadSelectionSet
Dim n As Integer
Dim strLinetype As String
Dim strLayer As String

    If ThisDrawing.SelectionSets.Count > 0 Then
        For n = 0 To ThisDrawing.SelectionSets.Count - 1
            If ThisDrawing.SelectionSets.Item(n).Name = "ChangeLine" Then
                ThisDrawing.SelectionSets("ChangeLine").Delete
            End If
        Next n
    End If

    Set OBJSELSET = ThisDrawing.SelectionSets.Add("ChangeLine")
    OBJSELSET.Select acSelectionSetAll

    For Each objSelected In OBJSELSET
strLinetype = ThisDrawing.Layers(objSelected.Layer).Linetype

objSelected.Linetype = strLinetype
    Next
ThisDrawing.SelectionSets("ChangeLine").Delete
End Sub

Private Sub CHANGELAYER()

Dim ENT As AcadEntity
    On Error Resume Next
    For Each ENT In ThisDrawing.ModelSpace
        ENT.Layer = "E-BASE-PLAN"
    Next ENT
    ThisDrawing.Regen acAllViewports
End Sub

All that is left is processing blocks and attributes
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

nivuahc

  • Guest
Re: Convert all to BYLAYER
« Reply #11 on: February 01, 2006, 01:52:20 PM »
Round 2...

Code: [Select]
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)

Code: [Select]
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

Code: [Select]
    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.

Code: [Select]
    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?

Code: [Select]
    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?

Code: [Select]
            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.
   
Code: [Select]
    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.

Code: [Select]
End Sub
This is the end of our first called sub-function (DELETELAYERS)

What follows is our second called sub-function (SETUPLAYERS)

Code: [Select]
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)

Code: [Select]
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.

Code: [Select]
'this is where we are at so far
A comment! :D

Code: [Select]
End Sub
This is the end of our third called sub-function (SETCOLORLINETYPE)

What follows is our fourth called sub-function (CHANGELAYER)

Code: [Select]
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! :)

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #12 on: February 01, 2006, 02:13:49 PM »
Code: [Select]
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?

Code: [Select]
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.

You are doing fine translating this

for each layer in this drawing layers collection, if its turned OFF (layeron=false) , make a selection set of ALL, then for each obj in SS, if the obj.Layer = ObjLayer.name (The name of the turned off layer), delete the object, repeat for next obj.  Then delete layer from DB
« Last Edit: February 01, 2006, 02:28:58 PM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

nivuahc

  • Guest
Re: Convert all to BYLAYER
« Reply #13 on: February 01, 2006, 02:33:39 PM »
Code: [Select]
Private Sub CHANGELAYER()

Dim ENT As AcadEntity
    On Error Resume Next
    For Each ENT In ThisDrawing.ModelSpace
        ENT.Layer = "E-BASE-PLAN"
    Next ENT
    ThisDrawing.Regen acAllViewports
End Sub

Other than a change in nomenclature ("ChangeLine") I think this is all that changed. And it seems that this changes the layer of each entity in the drawing to layer E-BASE-PLAN.

Shouldn't we have put something like this, though, in the SETCOLORLINETYPE sub?

Code: [Select]
objLayer.Color = acByLayer

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4073
Re: Convert all to BYLAYER
« Reply #14 on: February 01, 2006, 02:34:08 PM »
Okie doke, here is my attempt to "break it down, now"
For each entity on the drawing change it to layer VNDR-TEXT if it is text, mtext or rotated dimensions?
 that?
Yes, and what is weird is EVERY dimension is a rotated dimension once it has been inserted into the drawing. grab a few dims and look at your properties box
« Last Edit: February 01, 2006, 02:38:43 PM by CmdrDuh »
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)