- 积分
- 652
- 明经币
- 个
- 注册时间
- 2005-4-28
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
楼主 |
发表于 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 Sub
http://[dir=500,350]请输入地址[/dir][dir= ]c[/dir][/QUOTE] |
|