QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 2688|回复: 7
收起左侧

[已解决] 欲删除模型空间中所有的红色的直线用VBA该如何写?

[复制链接]
发表于 2010-4-1 08:17:50 | 显示全部楼层 |阅读模式 来自: 中国江苏南通

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

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

x
请教各路高手,欲删除模型空间中所有的红色的直线用VBA该如何写?谢谢!
发表于 2010-4-1 13:10:20 | 显示全部楼层 来自: 中国北京
  1. % ~( d( |/ b4 r6 K
  2.     Dim E As AcadEntity
    , I9 E" }7 H- M1 |) x4 \
  3.     For Each E In ThisDrawing.ModelSpace+ a* Z/ K* \$ T
  4.         If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete
    ! v. E" N/ v! V, B  G1 u* P
  5.     Next
    9 ]+ a1 T9 j9 }; M3 a
复制代码
 楼主| 发表于 2010-4-2 14:21:30 | 显示全部楼层 来自: 中国江苏南通
这个问题解决了,谢谢!
- b* t0 Z' E. Q$ [3 J% R5 l我初学autocad vba,有好多信息不知道在哪里找,比如line的objectname是“AcDbLine”
) q2 g( j$ t9 e请问这些属性该怎么找?谢谢!. ^, R' `( d) f3 D/ z% U" G
顺便另一个问题,如果我要删除所有半径为10的圆弧该如何写呢?
: `6 x; d; ?) I" L刚刚起步,问题比较傻瓜,还请不要见笑,谢谢啦!
发表于 2010-4-2 16:25:53 | 显示全部楼层 来自: 中国北京
本帖最后由 woaishuijia 于 2010-4-2 16:27 编辑
4 p. \* d- ]1 h) M# U# }7 i+ g- D8 d' Q/ B3 b3 |6 r. @
利用"监视"查看现有图元的属性.
/ ]9 L  i4 Q5 _$ t" f' x比如,在VBAIDE界面的代码窗口写一个空的过程

  1. 1 z" c8 A5 x4 d; C; S  E
  2. Sub A* B' n* g; {: }
  3. + d( l) G4 c$ J! K8 H0 B
  4. End Sub, q& j+ G2 i) A+ y& B/ O5 O
复制代码
% q0 ]- T, D" U) G2 Y. _
在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
$ \! q) U  a0 t& V当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.# t4 d3 q" N- o- O: E+ c: V: N
新建一个过程并在其中写入如下代码% }' f: r+ @9 F6 P
  1. 4 W+ _4 K1 u* Q' J( W7 \) M
  2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
    # K8 O. E% b' N  j
  3.     P2(0) = 10: l* {) E- ?3 Q  `; W3 x
  4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
    7 x3 v5 R  \8 Q. W: ^
复制代码
在监视窗口中添加监视"L.ObjectName".
" X2 R4 W& T6 h4 c: C当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".: F( }; C% b) Q' X
0 r. _+ ~. x6 t; a7 L# r
"删除所有半径为10的圆弧"可以这样写! t( k* U% a5 n/ `3 l7 O
  1. ( S3 P5 z- `3 j# n1 E# q) ?$ k! N0 h
  2.     Dim E As AcadEntity
    4 Y* C; w8 T& s% v. e8 x
  3.     For Each E In ThisDrawing.ModelSpace
    ) P4 L8 @( N  U, ?  f
  4.         If E.ObjectName = "AcDbArc" Then
    5 n+ _0 |& ?8 _9 {) D
  5.             If E.Radius = 10 Then E.Delete
    9 p, q0 U3 @( Y: L' R$ L
  6.         End If
    5 F, h. `, ~( h; ~, o
  7.     Next
    6 }  K: }/ V* j4 d9 Y+ v
复制代码
 楼主| 发表于 2010-4-3 11:46:41 | 显示全部楼层 来自: 中国江苏南通
多谢版主的解释,关于监视,我还要研究一下:试了一下,还没有摸着门道。有没有相关教程呢?或者烦劳版主录一段小小的操作视频,以帮助我们这些初学者入门,不知是否可以?非常感谢!!!
 楼主| 发表于 2010-4-6 10:00:53 | 显示全部楼层 来自: 中国江苏南通
自己摸到了,不烦劳版主了,谢谢!!!
发表于 2010-5-10 10:43:04 | 显示全部楼层 来自: 中国江苏无锡
版本就是热心哈..这样也顺便帮我看看..这段代码如何改写成VB/VBA代码,弧长标注..
  1. (Defun C:DimArcLen()! V2 [: U: B9 l2 }! `" t6 H. K
  2.   (Vl-Load-Com)
    " _' |9 s2 N  M( \# q0 \
  3.   (SetQ EntPnt (EntSel "\n选择圆弧:")9 h  U/ p6 P" G1 L
  4.         Ent    (Car EntPnt)
    1 L4 b) p+ K; t+ n: k
  5.         Obj    (Vlax-EName->Vla-Object Ent). P$ {9 l) N! H! d* D. {
  6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2): q% H$ E. X" {& H% s
  7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)* ?5 A& J- m  ~  O
  8.   )
    . B8 B% R* l0 Q
  9.   (Command "_DimAngular" EntPnt "M" Txt )
    : E. o4 |2 ~& K6 H% A$ p
  10. ): K* c$ H6 g% \3 x7 b) T8 @
复制代码
发表于 2010-5-10 14:47:24 | 显示全部楼层 来自: 中国天津
本帖最后由 woaishuijia 于 2010-5-10 14:52 编辑 % ]5 x8 w1 `, v/ q4 S
# f' d  v6 R. H3 Q+ ]5 b. p
7# clearsee
  1. - I+ P; H+ t: Q
  2. Sub DimArcLen()
    ) g; \2 J  ?! Z7 {5 x
  3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular/ s' f, |$ b6 ?8 F
  4.     On Error GoTo 10
    " z* k8 H% }! e+ @
  5.     With ThisDrawing
    & W5 X  m/ B! g! T5 u
  6.         If .ActiveSpace = acModelSpace Then
    $ [  f6 Y" R: W8 Y
  7.             Set Space = .ModelSpace
    ( a+ C$ s% H# w% _1 B
  8.         Else
    - e: w6 o' D! V) h" i: @, z: e
  9.             Set Space = .PaperSpace
    . z, q; Q* F3 t4 D5 h
  10.         End If
    * D, }# P4 P! K9 E: {
  11.         .Utility.GetEntity Obj, Point, "选择圆弧:"" ^7 b; e# j$ P  s9 S* I
  12.         If Obj.ObjectName = "AcDbArc" Then% p4 I0 I/ a2 p
  13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))0 a/ w& g: m; i) Y8 M# Q
  14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
    & Y3 E9 z' P% F$ ^; z
  15.         End If8 c% ~/ H+ E) ~4 ~8 y6 g
  16.     End With
    & g# X8 X; g6 P
  17. 10: End Sub  m8 l. }8 [, l2 f& g9 U' c2 D  `3 O
复制代码
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

快速回复 返回顶部 返回列表