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

157787698 · 发表于 2011-5-12 10:42:06

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 woaishuijia 于 2011-5-13 04:56 编辑

我要新建图层，并要设置图层线型，但是我在设置中心线的时候出现问题，提示未找到主键，程序如下：

Dim layer As AcadLayer# ?/ c6 Q* f4 p; `
Set layer = ThisDrawing.Layers.Add("ZXXC") '中心线层
4 @& r/ A- `- Z8 H6 b, c7 P2 p
layer.Lineweight = acLnWt018) ~7 B" h: z; t# ]- `6 V' @. z
layer.color = acBlue
$ c- V' \5 A$ J
layer.Linetype = "CENTER"
: |) K% [% }5 \: c
ThisDrawing.ActiveLayer = layer

复制代码

出现问题的是：layer.Linetype = "CENTER"
提示如下：
未找到主键.JPG

请帮助，谢谢。

woaishuijia · 发表于 2011-5-13 05:04:32

本帖最后由 woaishuijia 于 2011-5-13 05:05 编辑

设置线型之前应保证线型已被加载

Dim layer As AcadLayer# Q G+ k q/ o* _2 v
Set layer = ThisDrawing.Layers.Add("ZXXC" ) '中心线层+ k5 b! b+ n8 D( {
layer.Lineweight = acLnWt018( V+ l9 J' ]; t5 \, N" j
layer.color = acBlue
9 f4 S2 T2 ]. y+ v
ThisDrawing.Linetypes.Load "center", "acadiso.lin"
( c: p# t6 V( O
layer.Linetype = "CENTER"
6 m) C7 D) J p) | g) E( e
ThisDrawing.ActiveLayer = layer

复制代码

157787698 · 发表于 2011-5-13 09:14:21

谢谢，非常感谢

bingdianfeishui · 发表于 2011-5-15 20:44:43

本帖最后由 bingdianfeishui 于 2011-5-15 20:45 编辑

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：

ii = 0 '如果未加载“CENTER”线型，则加载
6 |# N, ?5 ?& s/ b& n& m% ]
For Each element In ThisDrawing.Linetypes& \9 Y7 |, [; g# }/ G6 [
If element.Name = "CENTER" Then6 h& H- Q& s5 `- X) G& I/ Q
ii = 1
/ Z1 O' z! J, n0 L# K- r
Exit For
; y; a& r# z1 I
End If& O. i; @, E) ^* \6 T# y3 Y
Next element
9 b1 l* w& F" A* p( f1 N* {
If ii = 0 Then9 p8 @# O' {0 k) N- o8 ~3 d* X
ThisDrawing.Linetypes.Load "Center", "acadiso.lin"% O. a5 ^. N4 ?+ r( p- D
End If
y) H* f8 P W$ T9 @) C" s

复制代码

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

157787698 · 发表于 2011-5-16 14:51:13

4# bingdianfeishui

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

157787698 · 发表于 2011-6-9 17:24:48

如果已经加载了center线型，再加载的话会报错，所以最好做一个判断。如下：
8 Y( ^) ^( u2 }8 w4 D7 tii = 0 '如果未加载“CENTER”线型，则加载* o5 m; `" J& k2 t5 F
For Each element In ThisDrawing.Linetypes
/ m! k; e N& W! v8 Y- b. J2 e If element ...# W/ e5 ]- |* ^
bingdianfeishui 发表于 2011-5-15 20:44 http://www.3dportal.cn/discuz/images/common/back.gif

还是谢谢

		自动登录	找回密码
密码			注册

全站		goto3d 说: 此次SW竞赛获奖名单公布如下，抱歉晚了，版主最近太忙：一等奖：塔山817；二等奖：a9041、飞鱼；三等奖：wx_dfA5IKla、xwj960414、bzlgl、hklecon；请以上各位和版主联系，领取奖金！！！	2022-03-11
全站		goto3d 说: 在线网校新上线表哥同事（Mastercam2022）+虞为民版大（inventor2022）的最新课程，来围观吧！	2021-06-26

通知

[已答复] VBA:如何设置新建图层的线型？

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分