QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 2689|回复: 7
收起左侧

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

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

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

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

x
请教各路高手,欲删除模型空间中所有的红色的直线用VBA该如何写?谢谢!
发表于 2010-4-1 13:10:20 | 显示全部楼层 来自: 中国北京
  1. " w. k' L! J; X% X
  2.     Dim E As AcadEntity3 Z! e. _2 F6 Y; i2 p* @2 U
  3.     For Each E In ThisDrawing.ModelSpace% p3 a9 e5 D; j: B6 _7 f+ Z
  4.         If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete" p; X6 J- q2 X2 R' g
  5.     Next
    6 d* M/ F  s7 c3 A0 p7 _
复制代码
 楼主| 发表于 2010-4-2 14:21:30 | 显示全部楼层 来自: 中国江苏南通
这个问题解决了,谢谢!
# T5 X8 [8 ~% |4 T( e8 O# v  d我初学autocad vba,有好多信息不知道在哪里找,比如line的objectname是“AcDbLine”7 S: S+ P6 b8 f$ B
请问这些属性该怎么找?谢谢!: v# _2 g7 p. Z* J
顺便另一个问题,如果我要删除所有半径为10的圆弧该如何写呢?
5 B9 u/ z6 z" s/ {7 N刚刚起步,问题比较傻瓜,还请不要见笑,谢谢啦!
发表于 2010-4-2 16:25:53 | 显示全部楼层 来自: 中国北京
本帖最后由 woaishuijia 于 2010-4-2 16:27 编辑
* W& `# o& ~" E4 h8 n3 t5 E2 k, r: h* N2 i, V! D
利用"监视"查看现有图元的属性.
$ ]! \" ]% S# E; \2 h& M比如,在VBAIDE界面的代码窗口写一个空的过程
  1. 1 G3 }% M% I  Y; @# N" I) d2 d0 Q! P5 e
  2. Sub A
    8 H- S: L! H0 h5 z/ w
  3. " d  u- j  {9 Y  k( y
  4. End Sub
    ' I5 \" e' `5 p% i8 E; q; M. e* o6 s8 r7 K
复制代码

3 u- u6 V" h2 i: b, h3 v6 Y在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.
/ [/ k) f- W7 V2 N5 M, N8 d  w当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
- q4 V2 x% ]( M8 ?8 y7 S新建一个过程并在其中写入如下代码
+ J+ F% d) C  T1 Q5 l' W+ C
  1. 9 n6 S4 m3 w# v$ G2 ^" F& E5 r) U' u
  2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double; Z) S( X) w: r1 o
  3.     P2(0) = 10% s$ d8 D4 r% u
  4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2): P5 e' Z( N. L9 T2 O
复制代码
在监视窗口中添加监视"L.ObjectName".
+ E5 u9 [7 @' R. o9 _当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".
* R& c' o+ Z) D9 b* T
. X. e+ O& R1 Z' U"删除所有半径为10的圆弧"可以这样写
8 E/ E9 n) c* D* h
  1. + V! L3 i+ V4 i9 V* P
  2.     Dim E As AcadEntity& q3 @) i: `, u0 D% @
  3.     For Each E In ThisDrawing.ModelSpace9 E- h1 n. \3 m2 n: N$ x1 X
  4.         If E.ObjectName = "AcDbArc" Then; l6 c( y/ D* v! N/ B
  5.             If E.Radius = 10 Then E.Delete
    " o' ?* g% S% g
  6.         End If* y/ s7 d& U6 B! ^- i+ |* j) ~
  7.     Next
    1 V, d6 M. P# @( E: x
复制代码
 楼主| 发表于 2010-4-3 11:46:41 | 显示全部楼层 来自: 中国江苏南通
多谢版主的解释,关于监视,我还要研究一下:试了一下,还没有摸着门道。有没有相关教程呢?或者烦劳版主录一段小小的操作视频,以帮助我们这些初学者入门,不知是否可以?非常感谢!!!
 楼主| 发表于 2010-4-6 10:00:53 | 显示全部楼层 来自: 中国江苏南通
自己摸到了,不烦劳版主了,谢谢!!!
发表于 2010-5-10 10:43:04 | 显示全部楼层 来自: 中国江苏无锡
版本就是热心哈..这样也顺便帮我看看..这段代码如何改写成VB/VBA代码,弧长标注..
  1. (Defun C:DimArcLen()$ c$ l3 I4 m3 }" A5 o( r
  2.   (Vl-Load-Com)- T$ a* ~  Z1 b9 j* _( [% m
  3.   (SetQ EntPnt (EntSel "\n选择圆弧:"). `6 W! m1 n' M: m- t, [- b# f
  4.         Ent    (Car EntPnt)
    ) _3 u0 ?3 q: @$ h7 _
  5.         Obj    (Vlax-EName->Vla-Object Ent)' O: ?0 t7 N+ n4 X
  6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2)5 _, S: ]! k+ L5 _
  7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)
    / o% [9 I0 N8 J9 e
  8.   )
    3 ^; U) m+ H0 C! H; \
  9.   (Command "_DimAngular" EntPnt "M" Txt )+ `) ]- c. ^9 U4 X  T- i( s
  10. )7 g  `* D: f; \3 R& h3 Z6 s- g. T
复制代码
发表于 2010-5-10 14:47:24 | 显示全部楼层 来自: 中国天津
本帖最后由 woaishuijia 于 2010-5-10 14:52 编辑 " X4 h  K6 R: n, O: a8 [

' O, C% l5 c! _4 x7# clearsee

  1. 4 Q+ w8 \! N$ i( U% Q' z' r# k
  2. Sub DimArcLen()
    : n7 H/ J  ^  E5 l( f
  3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
    $ E' s5 p6 k) |8 o7 \, Z  O1 F
  4.     On Error GoTo 10
    $ x' S$ T) Q: J+ s* m2 B& W* Y  k
  5.     With ThisDrawing9 S4 o3 J( [$ U1 j
  6.         If .ActiveSpace = acModelSpace Then3 F; k, }5 e+ r3 h& }
  7.             Set Space = .ModelSpace/ E' h" j8 c  `- O; B' |; ^4 l
  8.         Else* Y* P( @" q! }! k6 k9 r/ ?# d
  9.             Set Space = .PaperSpace3 Y3 P4 I* A3 L7 I# V0 y7 C
  10.         End If
    # Q+ e3 c9 I1 ^- s7 u& [- L
  11.         .Utility.GetEntity Obj, Point, "选择圆弧:"
    % R, n2 v& ^( _
  12.         If Obj.ObjectName = "AcDbArc" Then, e% }- b' n# d: n$ a) C
  13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))
    8 n/ s, l5 k( b8 Y* l1 K2 L
  14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )( X. a9 l7 d& B# `' n, |( Y
  15.         End If
    ' e; U9 `! [8 @" M
  16.     End With: ]1 b# c5 y$ i& n, t% `7 m
  17. 10: End Sub" S" @' f2 j$ M* P% ]' C  o8 D/ G. v
复制代码
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


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

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

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