Jump to content

Colorproblems


AstroNout

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...