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

157787698

% a; X5 K) ]& n- h+ r+ f* \" D9 ]我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：
6 [8 _$ V, j9 J& T5 s
2 D4 ]( B9 j1 p" L( [

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC")        '中心线层
   
3.         layer.Lineweight = acLnWt018
   
4.         layer.color = acBlue
   4 P$ P6 p1 J' Q( N7 a
5.         layer.Linetype = "CENTER"
   
6.         ThisDrawing.ActiveLayer = layer

复制代码

0 `8 _5 k/ a* k% e# S
出现问题的是：layer.Linetype = "CENTER"
提示如下：

$ M( E; Z: ~% T0 Y请帮助，谢谢。

woaishuijia

- M* a. G  x" k) s+ F设置线型之前应保证线型已被加载

1.     Dim layer As AcadLayer
   
2.     Set layer = ThisDrawing.Layers.Add("ZXXC"  )      '中心线层
   
3.     layer.Lineweight = acLnWt018
   " Z2 s  D" ~# _4 i
4.     layer.color = acBlue
   
5.     ThisDrawing.Linetypes.Load "center", "acadiso.lin"
   # T: P6 }: t( p$ F0 y9 e$ y$ x
6.     layer.Linetype = "CENTER"
   7 X; ~; L5 e0 |! T: U
7.     ThisDrawing.ActiveLayer = layer

复制代码

157787698

谢谢，非常感谢

bingdianfeishui

4 O6 |; O- M+ T, |$ c! s- n& q1 b  [如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

1. ii = 0                              '如果未加载“CENTER”线型，则加载
   % q& M) @: w# k1 y$ k' ~0 z: {
2. For Each element In ThisDrawing.Linetypes
   
3.     If element.Name = "CENTER" Then
   : |4 M4 v% `  E
4.         ii = 1
   % v4 Q# E( s8 w+ I
5.         Exit For
   
6.     End If
   
7. Next element
   4 g5 }$ X  m8 Q( m" P, n
8. If ii = 0 Then
   + m# G5 f/ N7 m3 z/ `5 Q
9.     ThisDrawing.Linetypes.Load "Center", "acadiso.lin"
   
10. End If
    

复制代码

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

157787698

4# bingdianfeishui
8 i9 c9 b& s6 x+ X6 ?
4 b+ o: Y, b. T, z" t( w$ K直接使用on error resume next效果更好

157787698

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
ii = 0                              '如果未加载“CENTER”线型，则加载
For Each element In ThisDrawing.Linetypes
    If element ...
! Q1 C) h2 @% E4 @* V3 W7 V: ybingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

还是谢谢