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

qianlinjun

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

woaishuijia

1. 
   
2.     Dim E As AcadEntity
   . H7 j' k) y1 I5 y  T
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

这个问题解决了，谢谢！
我初学autocad vba，有好多信息不知道在哪里找，比如line的objectname是“AcDbLine”
" X2 H; C5 `# N* G9 @请问这些属性该怎么找？谢谢！
1 H; S, l3 \$ \2 R$ ]顺便另一个问题，如果我要删除所有半径为10的圆弧该如何写呢？
刚刚起步，问题比较傻瓜，还请不要见笑，谢谢啦！

woaishuijia

& ^$ ~, L. S) o- ^/ D# e
利用"监视"查看现有图元的属性.
比如,在VBAIDE界面的代码窗口写一个空的过程

1. 
   
2. Sub A
   5 l. g/ |9 a# g% q
3. 
   $ d; P+ d- b" J# z" T- M. H+ N5 g: j
4. End Sub
   & p/ r! u  \/ H. Q

复制代码

: ?4 ?/ W8 A2 N  `) E: Q在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
4 l% H, K% a# ~- t- z* h( Z! {$ V新建一个过程并在其中写入如下代码

1. 
   8 I' m7 \! n# m  E+ Z7 R
2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
   
3.     P2(0) = 10
   $ T* V" g; o- e0 B9 t+ {
4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
   % R0 n2 l4 {5 Y. ]8 ~

复制代码

在监视窗口中添加监视"L.ObjectName".
  ~8 u0 ^& d* ~! E- J当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".
  Q3 I4 ^% q5 a4 N! r, D, M
4 ]. \4 g+ l" L. ]"删除所有半径为10的圆弧"可以这样写
0 u* n2 E5 b, C7 Z+ i$ [$ }' X

1. 
   6 e. Y4 b8 {! I9 B3 h
2.     Dim E As AcadEntity
   " y/ T$ ]. H, L8 p7 R" e- s( [
3.     For Each E In ThisDrawing.ModelSpace
   
4.         If E.ObjectName = "AcDbArc" Then
   
5.             If E.Radius = 10 Then E.Delete
   ' ~% U& H( C- T1 n' u
6.         End If
   ' i& J6 d& O1 W( W% E/ t
7.     Next
   " L5 o2 D# Y. [& o

复制代码

qianlinjun

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

qianlinjun

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

clearsee

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

1. (Defun C:DimArcLen()
   
2.   (Vl-Load-Com)
   + Z/ N% I7 B: d* J4 L3 D
3.   (SetQ EntPnt (EntSel "\n选择圆弧:")
   
4.         Ent    (Car EntPnt)
   
5.         Obj    (Vlax-EName->Vla-Object Ent)
   ( K3 @% b+ y* E% q
6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2)
   4 J2 {$ f/ U. E2 M5 g4 @) E+ k( q/ M
7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)
   
8.   )
   
9.   (Command "_DimAngular" EntPnt "M" Txt )
   : h+ z7 l( p9 x9 M, \3 t
10. )
    

复制代码

woaishuijia

7# clearsee

1. 
   ( V: u+ j% w7 R6 @2 a3 }* X
2. Sub DimArcLen()
   
3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
   1 y) G: V0 o( `( _1 e% B7 b
4.     On Error GoTo 10
   
5.     With ThisDrawing
   7 y" b) ]5 Q( E6 J
6.         If .ActiveSpace = acModelSpace Then
   
7.             Set Space = .ModelSpace
   
8.         Else
   , N) l8 t  v# K" O
9.             Set Space = .PaperSpace
   0 j( p, p8 N) n" W8 g
10.         End If
    2 w5 U% Z$ k% o2 d2 U0 k$ e3 @
11.         .Utility.GetEntity Obj, Point, "选择圆弧:"
    
12.         If Obj.ObjectName = "AcDbArc" Then
    ! a3 e8 m! q" S. L$ `% h& J- V
13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
    3 Q9 S+ k0 C% h1 [# N7 k+ A
14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
    " q( ^( m0 h$ x% Q* a, l
15.         End If
    6 v) x. {) C, K3 M& x9 T" T
16.     End With
    ' W" |$ {9 l% Z  n
17. 10: End Sub
    % q/ x  [: Y1 C' }# m

复制代码