不知道是什么回事？
用break来裁剪一个闭合多段线的时候，有时候裁掉的部分是另外部分，而留下我想裁减的那部分：（所以用vba的sendcommand结合双元表，可能会导致以上后果 最好不要另起贴子讨论。
我在上个贴子已经说得很清楚了，这种操作方法与双元表没有关系，而是你的程序本身有问题。 但这个现象确实不是在程序里面才出现，
直接在CAD里面用break命令来操作有时就会出现那种情况，我在画图的时候就遇到过很多次 我已经跟你说过了，你可以使用偏移的方法，求偏移线直选择集线的交点，再通过交点来形成双元表实施修剪，这样可以很准确。如下(环境是VBA)：
Sub Trim()
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocument
'此句用于VBA
Set acadapp = ThisDrawing.Application
'此名用于VB
'Set acadapp = connectcad(acadapp)
Set acaddoc = acadapp.ActiveDocument
'此句用于VB
'AppActivate acadapp.Caption '让CAD得到焦点
Dim Pnt1 As Variant
Dim entObj1 As AcadEntity
acaddoc.Utility.GetEntity entObj1, Pnt1, "选择修剪边界："
Dim det1 As String
det1 = axEnt2lspEnt(entObj1)
Dim entObjOff As AcadEntity
Dim entObjOffs As Variant
'控制偏移的距离和方向的参数
Dim OffDist As Double
OffDist = 0.5
entObjOffs = entObj1.Offset(OffDist)
Set entObjOff = entObjOffs(0)
Dim Pnt2 As Variant
Dim entObj2 As AcadEntity
Dim sle1 As AcadSelectionSet
On Error Resume Next
Set sle1 = acaddoc.SelectionSets.Item("sle1")
sle1.Clear
If Err Then
Err.Clear
Set sle1 = acaddoc.SelectionSets.Add("sle1")
End If
acaddoc.Utility.Prompt "选择需要修剪的对象" & Chr(13)
sle1.SelectOnScreen
'Pnt2 = acaddoc.Utility.GetPoint(, "选择修剪方向")
Dim det2 As String
Dim IntPnt As Variant
Dim IntPnt1(2) As Double
Dim n As Integer
For Each entObj2 In sle1
IntPnt = entObj2.IntersectWith(entObjOff, acExtendNone)
If IsArray(IntPnt) Then
For n = 0 To UBound(IntPnt) Step 3
IntPnt1(0) = IntPnt(n + 0)
IntPnt1(1) = IntPnt(n + 1)
IntPnt1(2) = IntPnt(n + 2)
det2 = GetDoubleEntTable(entObj2, IntPnt1)
acaddoc.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
Next
End If
Next
entObjOff.Delete
Dim command_str As String
command_str = Chr(3) & Chr(3)
acaddoc.SendCommand command_str
acaddoc.Utility.Prompt "修剪完成!"
acaddoc.SendCommand command_str
'Set acadapp = Nothing
End
End Sub
'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
Dim entHandle As String
entHandle = entObj.Handle
GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
End Function
'转换点的函数
Public Function axPoint2lspPoint(Pnt As Variant) As String
axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function
'转换图元函数
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
Function connectcad(acadapp As AcadApplication) As AcadApplication '连接AUTOCAD
On Error Resume Next
'与autocad通信
Set acadapp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Function
End If
End If
Set connectcad = acadapp
End Function
'Private Sub Form_Initialize()
'Trim
'End Sub
以下为程序运行后的效果
为什么你这个方法有些线不能剪掉，或者剪掉了相反的部分
页:
[1]