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

157787698

' g+ T' {% k+ ~7 B, A: _* m$ Q
我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
) x7 ^6 Q$ G! j( I% }$ J0 K

1.     Dim layer As AcadLayer
   / z! K5 x" B8 H" S( v& x8 U- ~$ d
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
   * }$ F2 L4 \' [. \0 a
3.         layer.Lineweight = acLnWt018
   ; G& {3 J1 L  n; Y5 L- M
4.         layer.color = acBlue
   9 y8 M3 Y$ X( v7 i6 n
5.         layer.Linetype = "CENTER"
   ! ~: F$ I3 w. |- Q$ g- ]
6.         ThisDrawing.ActiveLayer = layer

复制代码

4 i( X$ s5 ^3 i5 h! `* g
出现问题的是：layer.Linetype = "CENTER"
提示如下：

请帮助，谢谢。

woaishuijia

# B5 u3 i  E/ i5 p5 g- s
设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   
4.     layer.color = acBlue
   ! \" ?6 x. @* E5 p) s
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   
6.     layer.Linetype = "CENTER"
   
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

6 J6 N  v7 }' E9 Q" m' |/ C
如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   
2. For Each element In ThisDrawing.Linetypes
   / Q, Y- M6 ?1 P. ~! c5 U- U+ f
3.     If element.Name = "CENTER" Then
   9 Y* R( ?- O" Q0 t
4.         ii = 1
   : H# m* \  m5 O6 N. ?: Y+ l
5.         Exit For
   
6.     End If
   ) O1 h, ]/ e" b. r& }8 _: L
7. Next element
   + s( E- M) m/ K# G# L
8. If ii = 0 Then
   
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   
10. End If
    7 V3 g- F: r3 E9 v/ ^

复制代码

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

157787698

4# bingdianfeishui

! F- p2 L% E' _直接使用on error resume next效果更好

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
, Y* B' U. H+ P# Z4 W) Tii = 0                              '如果未加载“CENTER”线型，则加载
7 ?/ D+ t' m. t$ s0 C& O  cFor Each element In ThisDrawing.Linetypes
9 k6 f$ v/ \" N: O5 Y    If element ...
, Q% J7 P4 p/ kbingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

还是谢谢