欲删除模型空间中所有的红色的直线用VBA该如何写？

qianlinjun

请教各路高手，欲删除模型空间中所有的红色的直线用VBA该如何写？谢谢！

woaishuijia

1. 
   
2.     Dim E As AcadEntity
   
3.     For Each E In ThisDrawing.ModelSpace
   
4.         If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete
   
5.     Next
   

复制代码

qianlinjun

这个问题解决了，谢谢！
. X/ r% {  W" `# ?# B我初学autocad vba，有好多信息不知道在哪里找，比如line的objectname是“AcDbLine”
请问这些属性该怎么找？谢谢！
顺便另一个问题，如果我要删除所有半径为10的圆弧该如何写呢？
# |6 }" ^$ Z1 v/ l" F5 U1 w% r刚刚起步，问题比较傻瓜，还请不要见笑，谢谢啦！

woaishuijia

% ~1 j8 G: g2 x) ~9 P
: y& K( `9 X. h* ]6 |) o1 z3 E利用"监视"查看现有图元的属性.
, R9 G+ O8 y/ E7 R; \! D5 p9 \2 n4 H: W比如,在VBAIDE界面的代码窗口写一个空的过程

1. 
   
2. Sub A
   # u0 d8 A, q# ~0 T' T
3. 
   5 L8 C* a) y' @- M; X2 H+ G! c
4. End Sub
   6 l7 k; @/ V/ x0 S' h

复制代码

在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
. d. Y3 ~4 y& h$ p2 }2 H当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
新建一个过程并在其中写入如下代码
8 Y9 a& Q* h* }9 e2 Y

1. 
   5 F4 r0 m" v' |$ A; ?0 v2 A
2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
   / n. i  \3 Q9 S. ]! g
3.     P2(0) = 10
   
4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
   * C" H( C! Q% ?+ c& d

复制代码

在监视窗口中添加监视"L.ObjectName".
当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".
8 D8 h# I) @7 p; H
+ |7 ~# r* {7 x' T$ B2 G5 P' I"删除所有半径为10的圆弧"可以这样写

1. 
   
2.     Dim E As AcadEntity
   + s/ G# _$ C! i' R
3.     For Each E In ThisDrawing.ModelSpace
   
4.         If E.ObjectName = "AcDbArc" Then
   9 W: i/ K) X; e
5.             If E.Radius = 10 Then E.Delete
   8 @9 ?0 u, K4 \% a  Z% k: ]
6.         End If
   + y9 t  d' `" q4 e
7.     Next
   " \" U$ q" v& I7 t4 G

复制代码

qianlinjun

多谢版主的解释，关于监视，我还要研究一下：试了一下，还没有摸着门道。有没有相关教程呢？或者烦劳版主录一段小小的操作视频，以帮助我们这些初学者入门，不知是否可以？非常感谢！！！

qianlinjun

自己摸到了，不烦劳版主了，谢谢！！！

clearsee

版本就是热心哈..这样也顺便帮我看看..这段代码如何改写成VB/VBA代码,弧长标注..

1. (Defun C:DimArcLen()
   
2.   (Vl-Load-Com)
   
3.   (SetQ EntPnt (EntSel "\n选择圆弧:")
   
4.         Ent    (Car EntPnt)
   
5.         Obj    (Vlax-EName->Vla-Object Ent)
   
6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2)
     v  |7 f. F/ {! R* x
7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)
   
8.   )
   . E, A* J% ~& Z$ H0 f, \0 s
9.   (Command "_DimAngular" EntPnt "M" Txt )
   
10. )
    

复制代码

woaishuijia

7# clearsee

1. 
   
2. Sub DimArcLen()
   , K# U* M- y0 n2 L3 D& i, A
3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
   
4.     On Error GoTo 10
   . p" k# J& r1 n4 J+ ?$ m
5.     With ThisDrawing
   0 \+ n- N- ^9 \2 D
6.         If .ActiveSpace = acModelSpace Then
   0 S3 c. R+ K, A) y& R/ w8 N
7.             Set Space = .ModelSpace
   3 t8 y8 {. u8 q* z( {0 R( X% K
8.         Else
   0 s0 F- W3 E6 G# ]5 s
9.             Set Space = .PaperSpace
   6 {! r/ X+ C# J, b' F8 W
10.         End If
    + x# A! e& z) W+ K5 B/ q
11.         .Utility.GetEntity Obj, Point, "选择圆弧:"
    
12.         If Obj.ObjectName = "AcDbArc" Then
    - |. y1 u6 w8 P: v8 ]
13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
    3 C- M5 R2 O6 F: _- f& H
14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
    + ~+ U0 z7 u' g
15.         End If
    
16.     End With
    * |& S7 _2 F. @+ p1 f. c0 _
17. 10: End Sub
    - A! A2 v  U* F1 X8 f3 u  @

复制代码