QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

全站
10天前
查看: 2638|回复: 7
收起左侧

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

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

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

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

x
请教各路高手,欲删除模型空间中所有的红色的直线用VBA该如何写?谢谢!
发表于 2010-4-1 13:10:20 | 显示全部楼层 来自: 中国北京
  1. " _% J: o$ }7 J; c' u
  2.     Dim E As AcadEntity2 a' e% B, @, A6 b: f+ M4 i
  3.     For Each E In ThisDrawing.ModelSpace" l" F/ `/ H- W
  4.         If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete
    0 L8 N' p- A6 x" U( n$ D* `
  5.     Next
    . F6 L0 }( y/ T) g0 m$ B; F
复制代码
 楼主| 发表于 2010-4-2 14:21:30 | 显示全部楼层 来自: 中国江苏南通
这个问题解决了,谢谢!6 O5 u1 G' ]# H# A/ E
我初学autocad vba,有好多信息不知道在哪里找,比如line的objectname是“AcDbLine”) n6 ?( G- D1 H. H9 ^
请问这些属性该怎么找?谢谢!4 A) b; ^2 M# C. f/ p7 R1 S
顺便另一个问题,如果我要删除所有半径为10的圆弧该如何写呢?# ~  o0 Q2 U' G- B
刚刚起步,问题比较傻瓜,还请不要见笑,谢谢啦!
发表于 2010-4-2 16:25:53 | 显示全部楼层 来自: 中国北京
本帖最后由 woaishuijia 于 2010-4-2 16:27 编辑 7 s+ t5 Z* }7 X8 Z2 c

0 C. e% V9 a  M: V, R) x利用"监视"查看现有图元的属性.
8 t/ Y: z  E# [2 G$ q0 ?比如,在VBAIDE界面的代码窗口写一个空的过程

  1. 5 I: w8 k/ q( Y4 T- |
  2. Sub A& H( @' e; m) P1 |0 }0 k
  3. 2 b" F1 r* r) v, i% l6 `+ c
  4. End Sub
    * w$ ^" N: e- i( C! Q+ ]
复制代码

3 A, p3 o; N, t! [( W在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
) B& a5 o% e: o& h- g/ e7 R当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
' E! q( ~' p, M0 S$ w新建一个过程并在其中写入如下代码
7 E0 G6 ^/ Y  z4 C5 I6 |
  1. " k. w6 L0 J* Y
  2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
    ! F& w  f4 i( V, A/ N; J* B
  3.     P2(0) = 10
    8 ?! A/ @8 r! W6 B0 p! U- T
  4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
      Q& u" `& x1 p2 Q, @* n2 D8 k  r( j
复制代码
在监视窗口中添加监视"L.ObjectName".% Z! S7 s6 i+ E( f- J" v# Y; q( q% C
当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine"./ V2 F; d- y- \- ~+ W) T

3 {7 t  K! J/ W  C"删除所有半径为10的圆弧"可以这样写
3 ?% a3 M, j& U$ x* [* p6 c. D4 ~
  1. ; @- r% I$ R2 C: J
  2.     Dim E As AcadEntity
    % ~, U  b' a; Q8 t: E* R) }
  3.     For Each E In ThisDrawing.ModelSpace
    $ G4 f/ j9 R! A0 a* {
  4.         If E.ObjectName = "AcDbArc" Then3 N# o% {/ M1 }. L
  5.             If E.Radius = 10 Then E.Delete
    + h4 W2 a" e0 `( N. b4 y
  6.         End If) x' [% p' c3 e' }+ o% M
  7.     Next: w) k- P0 S& q
复制代码
 楼主| 发表于 2010-4-3 11:46:41 | 显示全部楼层 来自: 中国江苏南通
多谢版主的解释,关于监视,我还要研究一下:试了一下,还没有摸着门道。有没有相关教程呢?或者烦劳版主录一段小小的操作视频,以帮助我们这些初学者入门,不知是否可以?非常感谢!!!
 楼主| 发表于 2010-4-6 10:00:53 | 显示全部楼层 来自: 中国江苏南通
自己摸到了,不烦劳版主了,谢谢!!!
发表于 2010-5-10 10:43:04 | 显示全部楼层 来自: 中国江苏无锡
版本就是热心哈..这样也顺便帮我看看..这段代码如何改写成VB/VBA代码,弧长标注..
  1. (Defun C:DimArcLen()# b/ Y/ e& F  T# a) ]
  2.   (Vl-Load-Com)% x, n0 W8 F3 b( L- a
  3.   (SetQ EntPnt (EntSel "\n选择圆弧:")
    5 }  a+ o1 q. \- ]" D$ M
  4.         Ent    (Car EntPnt)* J( W* e  @, a- j+ c; ?
  5.         Obj    (Vlax-EName->Vla-Object Ent)
    : s5 {# n# n$ Y7 \% i6 T
  6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2): n4 Z! G3 Y) B$ V' A, M
  7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)& [1 @5 A& g! X' z4 p# V
  8.   )+ K3 v- B8 m3 O7 O; q
  9.   (Command "_DimAngular" EntPnt "M" Txt )# c+ r1 g% B3 _+ o4 b! u
  10. )4 V- ^% T4 k* [/ L: S, d) S
复制代码
发表于 2010-5-10 14:47:24 | 显示全部楼层 来自: 中国天津
本帖最后由 woaishuijia 于 2010-5-10 14:52 编辑 6 M. f1 k& h. P
9 Z$ E: i2 d  v: b8 H* L
7# clearsee
  1. 7 h0 D3 K8 C( h, |# B  T9 C5 z
  2. Sub DimArcLen()
    * }1 F; v! _5 K6 p  ~
  3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
    4 W, q5 \! o: L; l) E* F, i
  4.     On Error GoTo 10( h2 |  |/ _; s2 L, d
  5.     With ThisDrawing
    - g5 y6 y1 S/ S( y0 o( m
  6.         If .ActiveSpace = acModelSpace Then
    3 \9 p- o9 Z! _. z
  7.             Set Space = .ModelSpace
    8 k3 \% |" v3 C0 x: X
  8.         Else
    # h1 n, j9 k& d
  9.             Set Space = .PaperSpace
    : ?* T3 l% l' |* u' ?% u7 s
  10.         End If
    0 d$ w, r( y1 ?* T' {% s
  11.         .Utility.GetEntity Obj, Point, "选择圆弧:"9 A0 J+ W' v, A0 _: T# h
  12.         If Obj.ObjectName = "AcDbArc" Then  `" O. |0 q  T# K$ s
  13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
    & j9 S$ H, ?7 J3 }0 W. T% S
  14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
      `, f# T0 m6 h  S
  15.         End If
    " n  `3 M$ ?3 D- i  I
  16.     End With
    1 r+ \; q& Q0 e4 y2 }- \7 U
  17. 10: End Sub% \1 u& C* p) y  O, k% R
复制代码
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

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

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