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

qianlinjun · 发表于 2010-4-1 08:17:50

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

x

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

woaishuijia · 发表于 2010-4-1 13:10:20

+ W) ?" k5 ^, L' g
Dim E As AcadEntity2 Y5 x0 a, u: b8 u, j4 w9 }
For Each E In ThisDrawing.ModelSpace
5 q2 _) q+ A8 j U
If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete" J$ j2 a4 c2 L
Next5 a4 Y- E6 @; a: d

复制代码

qianlinjun · 发表于 2010-4-2 14:21:30

这个问题解决了，谢谢！
我初学autocad vba，有好多信息不知道在哪里找，比如line的objectname是“AcDbLine”
请问这些属性该怎么找？谢谢！
顺便另一个问题，如果我要删除所有半径为10的圆弧该如何写呢？
刚刚起步，问题比较傻瓜，还请不要见笑，谢谢啦！

woaishuijia · 发表于 2010-4-2 16:25:53

本帖最后由 woaishuijia 于 2010-4-2 16:27 编辑

利用"监视"查看现有图元的属性.
比如,在VBAIDE界面的代码窗口写一个空的过程

复制代码

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

! Q" J7 J1 E7 w7 w" H$ U, _
Dim L As AcadLine, P1(2) As Double, P2(2) As Double
0 N+ j2 z, ?3 ~0 g! e2 w! o( }
P2(0) = 10
$ g; } r: }( |" f+ u; W8 c! e) r
Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)& e4 T6 g K7 _, {3 }. T. ^- h( ^

复制代码

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

"删除所有半径为10的圆弧"可以这样写

复制代码

qianlinjun · 发表于 2010-4-3 11:46:41

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

qianlinjun · 发表于 2010-4-6 10:00:53

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

clearsee · 发表于 2010-5-10 10:43:04

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

复制代码

woaishuijia · 发表于 2010-5-10 14:47:24

本帖最后由 woaishuijia 于 2010-5-10 14:52 编辑

7# clearsee

% v. k8 X% M$ v8 P* S. q) F; ?* f
Sub DimArcLen()
6 @; H2 l. _* M% e; ^
Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular( t6 P& j2 D0 [: G j+ p- V" C2 k
On Error GoTo 103 f& d. Y0 i+ p! P8 X2 E
With ThisDrawing N" E4 p+ ^& D& X
If .ActiveSpace = acModelSpace Then
, P, Y2 r% B+ p& Q: i) W
Set Space = .ModelSpace
" Z8 u' t* z8 J1 ~7 b
Else
5 l: I2 a- y& r
Set Space = .PaperSpace( V: `0 ?; w( g; c. J" {
End If
- K# }( c' {& G1 l& P# K, e' |+ b
.Utility.GetEntity Obj, Point, "选择圆弧:"
3 Q' H: a0 M1 N* E4 X+ V% h: b
If Obj.ObjectName = "AcDbArc" Then
% v+ o- ?0 j- Q' r {9 L/ |
Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
( ^$ r& |/ n% b1 T7 g7 g
DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )
* T, [) C u# ^. X9 o% s
End If s6 v5 ]4 r3 G3 J3 r2 c' O$ B- m& y
End With
6 n. ~" o a, B( X$ [
10: End Sub
) }2 u) X8 P U% h: g& e

复制代码

		自动登录	找回密码
密码			注册

通知