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

    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
    Pietari, Venäjä
    Posts
    1,684

    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
    61

    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
    61

    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
    Pietari, Venäjä
    Posts
    1,684

    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