[求助]3dface

WWWDONG

谁有办法降3dface转换为pline

my_computer

Sub main()
Dim Sel As AcadSelectionSet
Do While ThisDrawing.SelectionSets.Count <> 0
ThisDrawing.SelectionSets.Item(0).Delete
Loop
Set Sel = ThisDrawing.SelectionSets.Add("3DFace")
Sel.SelectOnScreen Dim Obj As AcadObject, My3DFace As Acad3DFace, Poins
For Each Obj In Sel
If TypeName(Obj) = "IAcad3DFace" Then
Set My3DFace = Obj
Poins = My3DFace.Coordinates
ReDim Preserve Poins(UBound(Poins) + 3)
Poins(UBound(Poins) - 2) = Poins(0)
Poins(UBound(Poins) - 1) = Poins(1)
Poins(UBound(Poins)) = Poins(2)
ThisDrawing.ModelSpace.AddPolyline Poins
Obj.Delete
End If
Next
End Sub

mccad

用SendCommand方法来炸开，然后再把线组合成Pline

my_computer

3楼的方法在速度上会更快一些。