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

157787698

8 g% E( o/ t0 L我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
. N8 r$ L2 i+ {+ F3 e/ g4 V

1.     Dim layer As AcadLayer
   $ c- `, _) f9 R$ b
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
     y" L' P- p" f- P! Y
3.         layer.Lineweight = acLnWt018
   * |- D, D7 x5 s9 e, O
4.         layer.color = acBlue
   
5.         layer.Linetype = "CENTER"
   
6.         ThisDrawing.ActiveLayer = layer

复制代码

+ E! o. ~, N/ ?4 {5 l# i
出现问题的是：layer.Linetype = "CENTER"
提示如下：

请帮助，谢谢。

woaishuijia

5 w/ j6 z( ^' d9 b. }0 M
设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   6 s+ @6 ]& ~, o- ~. a; T6 Q
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   ' I" A/ q" u/ m/ }& }5 r7 m
4.     layer.color = acBlue
   8 R' m/ e* H: D) A6 I* {4 C, `! r" }
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   . G% f; q3 d  u
6.     layer.Linetype = "CENTER"
   / m; p; b9 M9 T. f
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

0 u: w. t( H0 ], C2 W
; C' ^" E% X9 h8 s如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   $ ?5 B& k* b0 E) L6 g+ A$ C
2. For Each element In ThisDrawing.Linetypes
   
3.     If element.Name = "CENTER" Then
     O- O2 s, u' e* Z" T0 I/ U& g
4.         ii = 1
   + G: }% _- f, h  _% X6 W8 P
5.         Exit For
   0 {: W* K; n1 j. w, g3 {1 q
6.     End If
   
7. Next element
   * ^/ ]. ~/ Q9 O
8. If ii = 0 Then
   ' a; ]9 v! W8 \1 g8 p
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   
10. End If
    

复制代码

6 Z9 k/ M4 K; m0 [+ j) e6 p图层、选择集这些最好也这样做一下判断

157787698

4# bingdianfeishui

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

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
9 V- q& g- j( U* a. O  Eii = 0                              '如果未加载“CENTER”线型，则加载
For Each element In ThisDrawing.Linetypes
+ z- K1 T% A: m5 j+ e2 I$ `    If element ...
+ D, ]6 |' D. g* t+ a! X! ~bingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

还是谢谢