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

157787698

  R! o3 ]1 t9 T8 K% h) k
我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
  e6 S9 ^- R+ _6 e& h- E0 w
7 _8 r7 B9 k9 |4 s8 a7 b5 b4 X2 {

1.     Dim layer As AcadLayer
   $ h8 [! T8 f& T# U/ Y8 `; u$ ?, O
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
   
3.         layer.Lineweight = acLnWt018
   
4.         layer.color = acBlue
   ( O# g; c. u+ \
5.         layer.Linetype = "CENTER"
   
6.         ThisDrawing.ActiveLayer = layer

复制代码

出现问题的是：layer.Linetype = "CENTER"
$ k& W8 D, i. J! F8 V$ v# y8 Q0 ~提示如下：

$ h8 }; a, m& H请帮助，谢谢。

woaishuijia

8 D) V, w6 N; C+ J设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   " ?/ _2 L( o: R. H% T
4.     layer.color = acBlue
   
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   / Y7 B& E  _: K# z: E5 [4 J, U7 f
6.     layer.Linetype = "CENTER"
   
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

; V/ |! P) Z) }) N6 u( b
8 T) d# p3 t. Y3 I: u如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   
2. For Each element In ThisDrawing.Linetypes
   & s/ x& `- c& d  T/ `4 T
3.     If element.Name = "CENTER" Then
   / }1 D% n; [5 ~- V0 m) d
4.         ii = 1
   ' I: u: Z) O( f' l2 D9 N8 ^
5.         Exit For
   
6.     End If
   
7. Next element
   
8. If ii = 0 Then
   
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   
10. End If
    $ _4 v3 r9 O; c1 r! r0 }% V

复制代码

; X+ i$ B8 w, d- z- b) U9 y图层、选择集这些最好也这样做一下判断

157787698

4# bingdianfeishui
# X# A/ q. {+ `5 Q
直接使用on error resume next效果更好

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
ii = 0                              '如果未加载“CENTER”线型，则加载
- e7 e4 y) M2 {% G) m# z, p' h1 dFor Each element In ThisDrawing.Linetypes
    If element ...
& f+ I% k3 A4 Z: ^. V: abingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

3 M& J: H. v4 z
还是谢谢