QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

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

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

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

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

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

x
请教各路高手,欲删除模型空间中所有的红色的直线用VBA该如何写?谢谢!
发表于 2010-4-1 13:10:20 | 显示全部楼层 来自: 中国北京

  1. ' z0 M% V! w  `+ G
  2.     Dim E As AcadEntity( b4 l, k) i. U8 y9 g
  3.     For Each E In ThisDrawing.ModelSpace2 }4 D. p( ?3 y1 g
  4.         If E.ObjectName = "AcDbLine" And (E.color = acRed Or E.color = acByLayer And ThisDrawing.Layers.Item(E.Layer).color = acRed) Then E.Delete
      d* a3 A1 J, s8 F7 }: }. @
  5.     Next
    7 O5 @* m7 A; A2 e: h
复制代码
 楼主| 发表于 2010-4-2 14:21:30 | 显示全部楼层 来自: 中国江苏南通
这个问题解决了,谢谢!
3 l) e% Q: r9 b% |, u8 I$ Y% I我初学autocad vba,有好多信息不知道在哪里找,比如line的objectname是“AcDbLine”! t% W: y1 D" q5 S  Z
请问这些属性该怎么找?谢谢!
# G3 {/ T# X% k$ w$ E1 I顺便另一个问题,如果我要删除所有半径为10的圆弧该如何写呢?
9 v1 Z+ X( I# q! ]刚刚起步,问题比较傻瓜,还请不要见笑,谢谢啦!
发表于 2010-4-2 16:25:53 | 显示全部楼层 来自: 中国北京
本帖最后由 woaishuijia 于 2010-4-2 16:27 编辑 : y* d& @0 K, u2 i" T
. m; B* ^& W1 N( k; }/ R) q2 J
利用"监视"查看现有图元的属性.
1 G" f' }% Y: c. b9 ^比如,在VBAIDE界面的代码窗口写一个空的过程

  1.   f" ^4 A! r1 w
  2. Sub A
    - b: d, ^0 o% p( H
  3. . V6 v0 f: N, H
  4. End Sub
    ' r8 V0 c; m: ?1 K" E
复制代码
2 O8 K- ?' a& D/ r
在监视窗口中添加监视"Thisdrawing",然后按F8逐步运行这个过程(也可以用设置断点的方法),可以在监视窗口中看到当前文档及其子对象的绝大部分属性值.7 y& B: ]# h( O( e( `2 j
当然,这其中并不包括每个图元的ObjectName属性值,但我们可以用相似的办法得到.
- [" L  A. P# x  W* x% ~. S( B新建一个过程并在其中写入如下代码
9 W# J# j- D: k) w

  1. : a1 E& ]7 l7 {1 }/ f- W
  2.     Dim L As AcadLine, P1(2) As Double, P2(2) As Double
    / n( }4 C( J6 G$ B. b5 O
  3.     P2(0) = 10
    5 m$ ~) o/ F7 I# M  J7 f8 u5 J( c" Y
  4.     Set L = ThisDrawing.ModelSpace.AddLine(P1, P2)
    & U# J; K3 T5 A' g
复制代码
在监视窗口中添加监视"L.ObjectName".
; m8 G$ v' ^. E! o当运行完第三行后,监视窗口就会显示出这条直线的"ObjectName"属性值为"AcDbLine".
3 o, n: @0 g+ b  t8 [8 V# W& W. S" z: |- S& y3 x+ z( q) I
"删除所有半径为10的圆弧"可以这样写5 w, U9 f5 W; [/ c

  1. 5 G. o# Z+ f' M( z  J% ^. R* j
  2.     Dim E As AcadEntity. F  Y! p" l* ^# b
  3.     For Each E In ThisDrawing.ModelSpace& Y# h: n# s( z6 p( `
  4.         If E.ObjectName = "AcDbArc" Then
    . l+ t! T; A* B: Z" R5 x9 J8 P
  5.             If E.Radius = 10 Then E.Delete0 q4 B. ~2 x  v2 o% Q: e
  6.         End If
    % m' D" ?& X# W$ L. A: E$ ]8 V
  7.     Next6 y( A! W/ T+ S
复制代码
 楼主| 发表于 2010-4-3 11:46:41 | 显示全部楼层 来自: 中国江苏南通
多谢版主的解释,关于监视,我还要研究一下:试了一下,还没有摸着门道。有没有相关教程呢?或者烦劳版主录一段小小的操作视频,以帮助我们这些初学者入门,不知是否可以?非常感谢!!!
 楼主| 发表于 2010-4-6 10:00:53 | 显示全部楼层 来自: 中国江苏南通
自己摸到了,不烦劳版主了,谢谢!!!
发表于 2010-5-10 10:43:04 | 显示全部楼层 来自: 中国江苏无锡
版本就是热心哈..这样也顺便帮我看看..这段代码如何改写成VB/VBA代码,弧长标注..
  1. (Defun C:DimArcLen()9 I: |" k) w$ K) [* C' G9 g
  2.   (Vl-Load-Com)
    ( Z1 N8 }" w6 \( V* z
  3.   (SetQ EntPnt (EntSel "\n选择圆弧:")
    & I3 _. K. _: S6 W/ Z7 `
  4.         Ent    (Car EntPnt)9 D& [. ?7 k5 Z/ \
  5.         Obj    (Vlax-EName->Vla-Object Ent)
    ( Z# ^2 c" W$ G3 i  V
  6.         Txt    (Rtos(Vla-Get-ArcLength  Obj) 2 2)) a5 P& M% q7 }- |; G" R% Q/ z
  7.         Txt    (StrCat "\{\\Fgdt.shx|c0;^\}\\P" Txt)( w! y3 r6 y" `( ?% W# K1 T
  8.   )
    - b  _0 i. l& x6 P! P" H
  9.   (Command "_DimAngular" EntPnt "M" Txt )
    6 ~% w  w& P/ ^2 {. g. P* X) ^
  10. )* R, e; l$ I2 g. C& }1 A# c
复制代码
发表于 2010-5-10 14:47:24 | 显示全部楼层 来自: 中国天津
本帖最后由 woaishuijia 于 2010-5-10 14:52 编辑
$ U: @7 B3 m3 r+ v! G% a/ K% H: u4 E" R- R& U
7# clearsee
  1. : G0 ^" x' N9 y7 ^
  2. Sub DimArcLen()
    + A/ d, X6 w$ r) u6 n
  3.     Dim Space As AcadBlock, Obj As AcadEntity, Point As Variant, DimObj As AcadDim3PointAngular
    4 i" m' K; P$ d# [: R7 S  ?3 D
  4.     On Error GoTo 10+ R& l/ G% X: p) H2 _: p
  5.     With ThisDrawing
    0 e3 w! [- @5 q
  6.         If .ActiveSpace = acModelSpace Then. o0 ?: f% K/ k7 A
  7.             Set Space = .ModelSpace
    4 a7 j0 R- O. X2 [- s/ A! P) I. c- `
  8.         Else+ x, @5 A  E8 u8 [1 A% X" J
  9.             Set Space = .PaperSpace1 G, J1 S9 r. U6 }: D$ G) T
  10.         End If
    6 G4 S$ ~+ r4 w( N; [& Z9 F
  11.         .Utility.GetEntity Obj, Point, "选择圆弧:"
    $ W- ?8 D' p! E* C
  12.         If Obj.ObjectName = "AcDbArc" Then
    * m/ H7 W! V7 m
  13.             Set DimObj = Space.AddDim3PointAngular(Obj.Center, Obj.StartPoint, Obj.EndPoint, .Utility.GetPoint(, "指定标注弧线位置:" ))0 [  M5 g0 i* Z# q
  14.             DimObj.TextOverride = "{\Fgdt.shx|c0;^}\P" & Format(Obj.ArcLength, "0.##" )# X$ e9 F$ [# m' @5 k- l
  15.         End If
    + n: d; z* |* O6 W4 P' A
  16.     End With% `. E8 g  Q# Y! d4 T# A( l
  17. 10: End Sub
    5 C% J/ E+ J% w% u# w% ~4 ^
复制代码
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


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

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

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