+ Reply to Thread
Results 1 to 5 of 5

Thread: Colorproblems

  1. #1
    Full Member
    Computer Details
    AstroNout's Computer Details
    Operating System:
    Windows 7 Premium
    Computer:
    ASUS Notebook K72Jr Series
    Motherboard:
    ASUS K72Jr
    CPU:
    P6100 @ 2.00 GHz 2.00 GHz
    RAM:
    8GB
    Graphics:
    Mobility Radeon HD 5470
    Primary Storage:
    500 GB
    Using
    Map 3D 2011
    Join Date
    Jul 2011
    Location
    Oostkamp, Belgium
    Posts
    62

    Default Colorproblems

    Registered forum members do not see this ad.

    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

  2. #2
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Something like this would help
    Code:
     
    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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  3. #3
    Full Member
    Computer Details
    AstroNout's Computer Details
    Operating System:
    Windows 7 Premium
    Computer:
    ASUS Notebook K72Jr Series
    Motherboard:
    ASUS K72Jr
    CPU:
    P6100 @ 2.00 GHz 2.00 GHz
    RAM:
    8GB
    Graphics:
    Mobility Radeon HD 5470
    Primary Storage:
    500 GB
    Using
    Map 3D 2011
    Join Date
    Jul 2011
    Location
    Oostkamp, Belgium
    Posts
    62

    Default

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

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

  4. #4
    Full Member
    Computer Details
    AstroNout's Computer Details
    Operating System:
    Windows 7 Premium
    Computer:
    ASUS Notebook K72Jr Series
    Motherboard:
    ASUS K72Jr
    CPU:
    P6100 @ 2.00 GHz 2.00 GHz
    RAM:
    8GB
    Graphics:
    Mobility Radeon HD 5470
    Primary Storage:
    500 GB
    Using
    Map 3D 2011
    Join Date
    Jul 2011
    Location
    Oostkamp, Belgium
    Posts
    62

    Default

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

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

  5. #5
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Registered forum members do not see this ad.

    Glad you got it to work
    Cheers

    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts