Colorproblems

[AstroNout]

Hi guys

I've got a bit of an issue. I want to inherit the color from one layer to a new created one. For example:
NewLayer.color = OldLayer.color

Evidently that doesn't work. All examples on the net start from known info regarding the color. They just fill the RGB-colors in. That's a bit stupid, because you can use the code for 1 occasion. Duh!

Thanks for the help.
Arnout

[fixo]

Something like this would help

 
Option Explicit
Sub colorfrom()
Dim oLay As AcadLayer
Dim curLay As AcadLayer
Set curLay = ThisDrawing.Layers("OldOne")
Set oLay = ThisDrawing.Layers.Add("NewOne")
oLay.TrueColor = curLay.TrueColor
End Sub

~'J'~

[AstroNout]

Yeah, I tried something like that. Here's my code. Everything works except for the color...

sub N_Layer()

Dim aEnt As AcadEntity
Dim aLayer1, aLayer2 As AcadLayer
Dim aSSet As AcadSelectionSet
Dim strLayerName  As String
        
On Error GoTo Delete
    
Set aSSet = ThisDrawing.SelectionSets.Add("sset")
aSSet.SelectOnScreen

For Each aEnt In aSSet
     aLayer1 = aEnt.Layer
     strLayerName = "N_" & aLayer1
     Set aLayer2 = ThisDrawing.Layers.Add(strLayerName)
     aEnt.Layer = "N_" & aLayer1
     aEnt.Update
     aLayer2.Lineweight = acLnWt030
     aLayer2.TrueColor = aLayer1.TrueColor
Next

ThisDrawing.SelectionSets.Item("sset").Delete
    
Exit Sub
    
Delete:
    ThisDrawing.SelectionSets.Item("sset").Delete
End Sub

[AstroNout]

Ah, got it! I went over it, and realised that alayer1 wasn't defined properly. The for-loop should be:

    For Each aEnt In aSSet
            strLayerName = aEnt.Layer
            Set aLayer1 = ThisDrawing.Layers(strLayerName)
            If strLayerName Like "D_*" Then
                MsgBox "Object reeds in D_-layer", vbOKOnly, "Fout Object"
            ElseIf strLayerName Like "N_*" Then
                MsgBox "Object in N_-layer", vbOKOnly, "Fout Object"
            ElseIf strLayerName Like "E_*" Then
                MsgBox "Object in de Edge", vbOKOnly, "Fout Object"
            Else
                strLayerName = "N_" & strLayerName
                Set aLayer2 = ThisDrawing.Layers.Add(strLayerName)
                aEnt.Layer = strLayerName
                aEnt.Update
                aLayer2.Lineweight = acLnWt030
                aLayer2.TrueColor = aLayer1.TrueColor
            End If
    Next

[fixo]

Glad you got it to work
Cheers

~'J'~