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

qianlinjun

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

woaishuijia

1. 
   9 @1 n: e% U8 A" _% @% ~: g+ \
2.     Dim E As AcadEntity
   2 O, f8 s& w  o3 a8 B! S/ x
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
   6 N, W" h2 l' Q, T
5.     Next
   & p2 B7 s, ?+ B- Q5 z3 V3 A  E  ]/ _

复制代码

qianlinjun

这个问题解决了，谢谢！
我初学autocad vba，有好多信息不知道在哪里找，比如line的objectname是“AcDbLine”
请问这些属性该怎么找？谢谢！
$ |5 D0 K5 s  D: L* [顺便另一个问题，如果我要删除所有半径为10的圆弧该如何写呢？
2 g& J. T7 }9 G1 y5 e, A刚刚起步，问题比较傻瓜，还请不要见笑，谢谢啦！

woaishuijia

; r( N$ {) z  @  q; X7 C( S
7 l# b  E/ x0 H- p! l: B- s利用"监视"查看现有图元的属性.
比如,在VBAIDE界面的代码窗口写一个空的过程

1. 
   
2. Sub A
   
3. 
   
4. End Sub
   

复制代码

* Q8 z. }% _7 K" m/ }1 I9 {在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
* R, D, T% B8 N' R新建一个过程并在其中写入如下代码

1. 
   ) f; g7 d; `, k
2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
   5 D% C0 J# v" x) I% k8 ]3 j
3.     P2(0) = 10
   % ?  h$ f4 n4 \$ p/ D4 d
4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
   

复制代码

在监视窗口中添加监视"L.ObjectName".
当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".

"删除所有半径为10的圆弧"可以这样写
* A7 o$ M0 k( V# [* j

1. 
   
2.     Dim E As AcadEntity
   5 i. Q. a, y* }* e% E
3.     For Each E In ThisDrawing.ModelSpace
   
4.         If E.ObjectName = "AcDbArc" Then
   6 x- D6 b/ m8 W5 |5 O% L3 A( ?
5.             If E.Radius = 10 Then E.Delete
   : U$ U" d* `+ T( P- J! A& }
6.         End If
   
7.     Next
   # ?! [4 o2 b) b! z$ b' b

复制代码

qianlinjun

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

qianlinjun

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

clearsee

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

1. (Defun C:DimArcLen()
   
2.   (Vl-Load-Com)
   ( B" S& F1 I0 `, G
3.   (SetQ EntPnt (EntSel "\n选择圆弧:")
   
4.         Ent    (Car EntPnt)
   
5.         Obj    (Vlax-EName->Vla-Object Ent)
   / e  y: D6 ?8 F& Y
6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2)
   
7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)
   4 J8 A" X2 X2 L1 \. T) o( q
8.   )
   
9.   (Command "_DimAngular" EntPnt "M" Txt )
   - A! t1 T2 |6 V% c1 q
10. )
    + K' b& s" H# `. p& k& M" i( n# p

复制代码

woaishuijia

7# clearsee

1. 
   ' }. `4 Z3 D& ]
2. Sub DimArcLen()
   3 v& M8 y) N2 h' D. i+ z$ w
3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
   ) n8 K% g  w5 w1 z+ p' Z
4.     On Error GoTo 10
   5 {# O% _; L" r$ b
5.     With ThisDrawing
   9 P* g: F+ m9 U) B
6.         If .ActiveSpace = acModelSpace Then
   & N( o4 I$ m3 a) z
7.             Set Space = .ModelSpace
   5 Z5 }5 E) h4 A2 B; v
8.         Else
   8 G& P- j! u' }4 s% D
9.             Set Space = .PaperSpace
   
10.         End If
    
11.         .Utility.GetEntity Obj, Point, "选择圆弧:"
    9 i5 m/ S1 ^9 \1 m
12.         If Obj.ObjectName = "AcDbArc" Then
    8 C5 s: a9 S# E! e+ `) l# s( l3 n
13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
    
14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
    ( q  i# t& H7 }) ?" h2 S6 F
15.         End If
    ' \" \- }1 |* {+ B5 R6 v' D2 I
16.     End With
    
17. 10: End Sub
    

复制代码