怎么在VBA循环中定义图层颜色啊

yxh1202

    我编了个画纵断面的VBA，可是想在循环画地面线的时候，想利用循环语句为各种地面线赋予不同的图层并以颜色分开，但是执行结果都却是一个颜色。请高人指点，不胜感激。

 

'画地面线
  
    Dim point1() As Double
    ReDim point1(h)
    Dim t As Double
For l = 2 To 6

Set newLayer = ThisDrawing.Layers("l")
   ThisDrawing.ActiveLayer = newLayer
    newLayer.color = l  

 point1(0) = jd(0)
point1(1) = jd(1) + (xlSheet.Cells(2, l).Value - min) / by * 1000 + 20
'point1(2) = 0
u = 3
For t = 1 To k - 2
If u <= k + 1 Then
       point1(2 * t) = point1(0) + (xlSheet.Cells(u, 1).Value - xlSheet.Cells(2, 1)) / bx * 1000
       point1(2 * t + 1) = jd(1) + (xlSheet.Cells(u, l).Value - min) / by * 1000 + 20
  'point1(3 * t + 2) = 0
   u = u + 1
  End If
     Next t
 Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)
 Next l

fjfhgdwfn

Set newLayer = ThisDrawing.Layers("l")

加了“”，I不会变的啊。你的对象也都在一个层上吧！

 

yxh1202

谢谢指点，我的意思是假如有6种地面线，循环绘制的时候自动新建6种地面线图层，并且每个图层颜色区别开。怎么处理，谢谢高人

雪山飞狐_lzh

ThisDrawing.Layers(CStr(l))

yxh1202

谢谢lzh741206，我后来用数组分别给每个需要画的纵断面线赋予值，然后再语句中调用。谢谢你给的提示。

 

 

Dim varData(5) As Variant    '利用数组为纵断线设置图层提供基础
For i = 2 To 6
varData(i - 2) = xlSheet.Cells(1, i).Value
Next i

 

For l = 2 To 6
Set layObj = ThisDrawing.Layers.Add(varData(l - 2))
    ThisDrawing.ActiveLayer = Layers(varData(l - 2)) ' newLayer
    ActiveLayer.color = l
 point1(0) = jd(0)
 point1(1) = jd(1) + (xlSheet.Cells(2, l).Value - min) / by * 1000 + 15
'point1(2) = 0
u = 3
For t = 1 To k - 2
If u <= k + 1 Then
       point1(2 * t) = point1(0) + (xlSheet.Cells(u, 1).Value - xlSheet.Cells(2, 1)) / bx * 1000
       point1(2 * t + 1) = jd(1) + (xlSheet.Cells(u, l).Value - min) / by * 1000 + 15
  'point1(3 * t + 2) = 0
   u = u + 1
  End If
     Next t
 Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)
 Next l