乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 65|回复: 3

有没什么简便方法删除当前模型空间里某一区域内的所有块呢?

[复制链接]

14

主题

32

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
88
发表于 2005-5-27 19:44:00 | 显示全部楼层 |阅读模式
是这样的,在层ExtrudeFace和层zz-1里面分别有很多插入的块----树和路灯,现在要把在某个实体的上面的树和路灯删除,要怎么办呢?
是不是应该建立选择集?怎么样设置过滤条件呢?
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2005-5-27 21:32:00 | 显示全部楼层
应该建立选择集,过滤的条件是这两个层中的某个区域的对象。区域可以是矩形区域或多边形区域。
选择完对象后使用Erase方法来删除选择集及对象。
回复

使用道具 举报

14

主题

32

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
88
发表于 2005-5-29 10:51:00 | 显示全部楼层
就如下图所示,我删除4条3dpoly线围成区域内的所有块!要怎么办呢?我自己写了点代码,但运行老是出错,帮我看看好吗?mccad
       
Public Sub DelBlock()
定义选择集setb和setp分别用于选择块和4条3dpolyline线
Dim setb As AcadSelectionSet
Dim setp As AcadSelectionSet
Dim i As Integer
i = ThisDrawing.SelectionSets.Count
While (i)
Set setb = ThisDrawing.SelectionSets.Item(i - 1)
If setb.Name = "BlockR" Or setb.Name = "objlh" Then
                 setb.Delete
End If
i = i - 1
Wend
Set setb = ThisDrawing.SelectionSets.Add("BlockR")
Set setp = ThisDrawing.SelectionSets.Add("objlh")
Dim gpcode(1) As Integer
Dim datavalue(1) As Variant
gpcode(0) = 0
datavalue(0) = "polyline"
gpcode(1) = 8
datavalue(1) = "Pathh"
setp.Select acSelectionSetAll, , , gpcode, datavalue
查找选择集setp中两条相交polyline,把交点返回个cwp1,并把这两条线删除
Dim obj1 As Acad3DPolyline
Dim obj2 As Acad3DPolyline
Dim cwp1 As Variant
Dim cwp2 As Variant
Dim pnt As Variant
Set obj1 = setp.Item(0)
For i = 1 To setp.Count - 1
                         Set obj2 = setp.Item(i)
                         pnt = obj1.IntersectWith(obj2, acExtendNone)
                                 
                         If VarType(pnt)  vbEmpty Then
                                                 Set cwp1 = pnt
                                                 setp.Item(0).Delete
                                                 setp.Item(i).Delete
                                                 Exit For
                         End If
Next i
查找剩下的两条相交线,把交点返回给cwp2
Set obj1 = setp.Item(0)
For i = 1 To setp.Count - 1
                         Set obj2 = setp.Item(i)
                         pnt = obj1.IntersectWith(obj2, acExtendNone)
                         If VarType(pnt)  vbEmpty Then
                                                 Set cwp2 = pnt
                                                 setp.Item(0).Delete
                                                 setp.Item(i).Delete
                                                 Exit For
                         End If
Next i
setp.erase
选择区域内的块,清空!
gpcode(0) = 2
datavalue(0) = "BlockReference"
setb.Select acSelectionSetCrossing, cwp1, cwp2, gpcode, datavalue
setb.Erase
                 
End Subhttp://[dir=500,350]请输入地址[/dir][dir= ]c[/dir][/QUOTE]
回复

使用道具 举报

14

主题

32

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
88
发表于 2005-5-29 11:36:00 | 显示全部楼层
惨了,我现在不知道怎么把自己电脑上面的图片给贴上来了!
真是的!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-5 13:50 , Processed in 0.681402 second(s), 61 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表