AstroNout Posted April 11, 2012 Share Posted April 11, 2012 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted April 12, 2012 Share Posted April 12, 2012 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'~ Quote Link to comment Share on other sites More sharing options...
AstroNout Posted April 13, 2012 Author Share Posted April 13, 2012 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 Quote Link to comment Share on other sites More sharing options...
AstroNout Posted April 13, 2012 Author Share Posted April 13, 2012 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted April 13, 2012 Share Posted April 13, 2012 Glad you got it to work Cheers ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.