怎么删除特点条件的多段线呢？

fmfm

比如我要删除4条边的封闭多段线。谢谢啦

mccad

过滤出只有封闭的多段线，然后判断多段线是否为4个顶点，如果是则删除。

fmfm

hehe ~~谢谢 Dim pl As AcadEntity
Dim sss As AcadSelectionSet
Set sss = ThisDrawing.SelectionSets.Add("123")
Dim Gpcode(0) As Integer
Gpcode(0) = 0
Dim Datavalue(0) As Variant
Datavalue(0) = "lwpolyline"
sss.Select acSelectionSetAll, , , Gpcode, Datavalue
MsgBox sss.count
For Each pl In sss
If (UBound(pl.Coordinates) + 1) / 2 = 4 Then
pl.Delete
End If
Next

雪山飞狐_lzh

你获取的多段线是模型空间最后3个，不需要建选择集

fmfm

哦 这个呢 炸开轮廓线并保存到选择集 Dim explodedObjects As Variant
Dim outlinearr() As Variant
Dim outliness As AcadSelectionSet
Set outliness = ThisDrawing.SelectionSets.Add("ss")
explodedObjects = plent.Explode
For j = 0 To UBound(explodedObjects) - 1
explodedObjects(j).Update
Set outlinearr(j) = explodedObjects(j) 'subscript out of range ?????
explodedObjects(j).Update
Next
outliness.AddItems outlinearr

雪山飞狐_lzh

redim一下

RetVal = object.Explode

Object

MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_3dpoly_object.htm" target="_blank" >3DPolyline , MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_blockref_object.htm" target="_blank" >BlockRef, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_lightweightpolyline_object.htm" target="_blank" >LightweightPolyline, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_minsertblock_object.htm" target="_blank" >MInsertBlock, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_polygonmesh_object.htm" target="_blank" >Polygonmesh, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_polyline_object.htm" target="_blank" >Polyline, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_region_object.htm" target="_blank" >Region
The object or objects this method applies to.

RetVal

Variant (array of objects)
The array of exploded objects.

或直接用

dim a as Variant

a=pPline.Explode

fmfm

这也有问题？


outliness.AddItems outlinearr


说 Invalid argument        pselset in        additems

雪山飞狐_lzh

我这样没问题呀 Sub test()
Dim a As Variant
a = ThisDrawing.ModelSpace(0).Explode
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.ActiveSelectionSet
ss.AddItems a
MsgBox ss.Count
ss.Clear
End Sub

fmfm

你的可以


发现炸开以后pline还在

雪山飞狐_lzh

一个Bug，块引用也一样


要在Explode方法后调用Delete方法干掉它