VBA:如何设置新建图层的线型？

157787698

( r1 Q0 _7 e( Z) y9 O
我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
) Q' W  O$ Y/ c: [9 h
7 R  _8 m" c- k1 U4 o

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
   + P7 l) z7 ^! W% Y9 G. h
3.         layer.Lineweight = acLnWt018
   ' I/ V4 I) {, @2 W5 x) [
4.         layer.color = acBlue
   3 R" {: U3 F1 k- c0 y* v
5.         layer.Linetype = "CENTER"
   6 N0 d) c7 O9 y; P& G' f
6.         ThisDrawing.ActiveLayer = layer

复制代码

! @4 a1 u7 R+ }  f出现问题的是：layer.Linetype = "CENTER"
提示如下：

请帮助，谢谢。

woaishuijia

! R+ o8 Z# j$ o$ ^7 _( J8 t设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   
4.     layer.color = acBlue
   
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   
6.     layer.Linetype = "CENTER"
     d+ }% g3 ^& R: |% I. `
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   6 C# h# J/ d) p
2. For Each element In ThisDrawing.Linetypes
   
3.     If element.Name = "CENTER" Then
   
4.         ii = 1
   
5.         Exit For
   
6.     End If
   ) k- g, O0 Q/ e
7. Next element
   * T5 [3 J$ d1 t/ r( C3 s
8. If ii = 0 Then
   
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   
10. End If
    8 F  Y7 a2 N# g) N8 N) {3 x% u

复制代码

图层、选择集这些最好也这样做一下判断

157787698

4# bingdianfeishui

直接使用on error resume next效果更好

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
' p2 U" |# h9 bii = 0                              '如果未加载“CENTER”线型，则加载
7 _0 L6 M; w9 {% f9 @For Each element In ThisDrawing.Linetypes
    If element ...
# u3 ^: I; v( }1 D0 Dbingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

6 b6 t( J6 G5 X8 s- d
9 W- ^  f' p. h还是谢谢