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

157787698

我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
" T- @( {4 J* {3 N

1.     Dim layer As AcadLayer
   ! q; P0 s4 o  r& D; S2 ^. O
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
   9 H6 K# x( M4 V- x
3.         layer.Lineweight = acLnWt018
   2 ^8 T" i4 [& D& E5 q# T8 F
4.         layer.color = acBlue
   + o  t: }* `1 _* h+ o$ [* q( j! j
5.         layer.Linetype = "CENTER"
   
6.         ThisDrawing.ActiveLayer = layer

复制代码

4 ]6 K% U/ G3 `4 V; z1 w$ E
/ `: n3 }5 e$ h/ g7 U$ B出现问题的是：layer.Linetype = "CENTER"
9 m, |6 `  T4 K( G  f# y7 x提示如下：

+ S" y) S2 u' B- a% p' R% P请帮助，谢谢。

woaishuijia

9 a) B8 z9 ?1 _( ?) q- d: Z设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   ! ~% u9 E% `# P) W& v; c8 ?
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   & K% e! j% s5 f& q' v
4.     layer.color = acBlue
   
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   1 F; J4 F  i+ z9 R3 p3 V, L$ e
6.     layer.Linetype = "CENTER"
   
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

( a- a# k. r8 Q# R
$ {7 y6 y% W( a2 w, j& X0 z如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   2 i- m' T+ n3 B6 e/ R  Q7 l( T
2. For Each element In ThisDrawing.Linetypes
   
3.     If element.Name = "CENTER" Then
   
4.         ii = 1
   
5.         Exit For
   
6.     End If
   ) ^+ ]6 U1 y' S. I
7. Next element
   
8. If ii = 0 Then
   6 {% f3 J% U0 p) L% S
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   : T" I* |5 I8 @: Q% l5 m$ P4 a
10. End If
    

复制代码

! a6 n* A5 B7 f. I图层、选择集这些最好也这样做一下判断

157787698

4# bingdianfeishui
2 M! F: x1 h: @! t& N3 O0 H1 P
- g* ?8 z' k4 o3 Q8 j3 R  f+ A+ H直接使用on error resume next效果更好

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
ii = 0                              '如果未加载“CENTER”线型，则加载
For Each element In ThisDrawing.Linetypes
( c9 V. j/ e& [2 N    If element ...
- I7 @! T' ?4 \% d+ T% z/ ^bingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

还是谢谢