不知道是什么回事？

topirol

用break来裁剪一个闭合多段线的时候，有时候裁掉的部分是另外部分，而留下我想裁减的那部分：（


所以用vba的sendcommand结合双元表，可能会导致以上后果

mccad

最好不要另起贴子讨论。
我在上个贴子已经说得很清楚了，这种操作方法与双元表没有关系，而是你的程序本身有问题。

topirol

但这个现象确实不是在程序里面才出现，

直接在CAD里面用break命令来操作有时就会出现那种情况，我在画图的时候就遇到过很多次

mccad

我已经跟你说过了，你可以使用偏移的方法，求偏移线直选择集线的交点，再通过交点来形成双元表实施修剪，这样可以很准确。如下(环境是VBA)：

2. Sub Trim()
   
3.     Dim acadapp As AcadApplication
   
4.     Dim acaddoc As AcadDocument
   
5.     '此句用于VBA
   
6.     Set acadapp = ThisDrawing.Application
   
7.     '此名用于VB
   
8.     'Set acadapp = connectcad(acadapp)
   
9.     Set acaddoc = acadapp.ActiveDocument
   
10.     '此句用于VB
    
11.     'AppActivate acadapp.Caption '让CAD得到焦点
    
12.    
    
13.    
    
14.     Dim Pnt1 As Variant
    
15.     Dim entObj1 As AcadEntity
    
16.     acaddoc.Utility.GetEntity entObj1, Pnt1, "选择修剪边界："
    
17.     Dim det1 As String
    
18.     det1 = axEnt2lspEnt(entObj1)
    
19.    
    
20.     Dim entObjOff As AcadEntity
    
21.     Dim entObjOffs As Variant
    
22.    
    
23.     '控制偏移的距离和方向的参数
    
24.     Dim OffDist As Double
    
25.     OffDist = 0.5
    
26.     entObjOffs = entObj1.Offset(OffDist)
    
27.     Set entObjOff = entObjOffs(0)
    
28.    
    
29. 
    
30.     Dim Pnt2 As Variant
    
31.     Dim entObj2 As AcadEntity
    
32.    
    
33.     Dim sle1 As AcadSelectionSet
    
34.    
    
35.    
    
36.     On Error Resume Next
    
37.    
    
38.     Set sle1 = acaddoc.SelectionSets.Item("sle1")
    
39.     sle1.Clear
    
40.     If Err Then
    
41.     Err.Clear
    
42.     Set sle1 = acaddoc.SelectionSets.Add("sle1")
    
43.     End If
    
44.    
    
45.     acaddoc.Utility.Prompt "选择需要修剪的对象" & Chr(13)
    
46.    
    
47.     sle1.SelectOnScreen
    
48.    
    
49.     'Pnt2 = acaddoc.Utility.GetPoint(, "选择修剪方向")
    
50.     Dim det2 As String
    
51.    
    
52.     Dim IntPnt As Variant
    
53.     Dim IntPnt1(2) As Double
    
54.     Dim n As Integer
    
55.     For Each entObj2 In sle1
    
56.     IntPnt = entObj2.IntersectWith(entObjOff, acExtendNone)
    
57.    
    
58.     If IsArray(IntPnt) Then
    
59.         For n = 0 To UBound(IntPnt) Step 3
    
60.             IntPnt1(0) = IntPnt(n + 0)
    
61.             IntPnt1(1) = IntPnt(n + 1)
    
62.             IntPnt1(2) = IntPnt(n + 2)
    
63.             det2 = GetDoubleEntTable(entObj2, IntPnt1)
    
64.             acaddoc.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
    
65.         Next
    
66.     End If
    
67.     Next
    
68.    
    
69.     entObjOff.Delete
    
70.    
    
71.     Dim command_str As String
    
72.     command_str = Chr(3) & Chr(3)
    
73.     acaddoc.SendCommand command_str
    
74.     acaddoc.Utility.Prompt "修剪完成!"
    
75.     acaddoc.SendCommand command_str
    
76.    
    
77.     'Set acadapp = Nothing
    
78.     End
    
79.    
    
80. 
    
81. End Sub
    
82. 
    
83. '转换双元表的函数
    
84. 
    
85. Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
    
86.     Dim entHandle As String
    
87.     entHandle = entObj.Handle
    
88.     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
    
89.                      ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
    
90. End Function
    
91. 
    
92. '转换点的函数
    
93. 
    
94. Public Function axPoint2lspPoint(Pnt As Variant) As String
    
95.     axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
    
96. End Function
    
97. 
    
98. '转换图元函数
    
99. 
    
100. Public Function axEnt2lspEnt(entObj As AcadEntity) As String
     
101.     Dim entHandle As String
     
102.     entHandle = entObj.Handle
     
103.     axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
     
104. End Function
     
105. 
     
106. 
     
107. Function connectcad(acadapp As AcadApplication) As AcadApplication '连接AUTOCAD
     
108. 
     
109. 
     
110. On Error Resume Next
     
111.      
     
112.     '与autocad通信
     
113.      
     
114.     Set acadapp = GetObject(, "AutoCAD.Application")
     
115.     If Err Then
     
116.         Err.Clear
     
117.         Set acadapp = CreateObject("AutoCAD.Application")
     
118.         If Err Then
     
119.             MsgBox Err.Description
     
120.             Exit Function
     
121.         End If
     
122.     End If
     
123. Set connectcad = acadapp
     
124. End Function
     
125. 
     
126. 'Private Sub Form_Initialize()
     
127. 'Trim
     
128. 'End Sub
     

Sub Trim()<br />     Dim acadapp As AcadApplication<br />     Dim acaddoc As AcadDocument<br />     '此句用于VBA<br />     Set acadapp = ThisDrawing.Application<br />     '此名用于VB<br />     'Set acadapp = connectcad(acadapp)<br />     Set acaddoc = acadapp.ActiveDocument<br />     '此句用于VB<br />     'AppActivate acadapp.Caption '让CAD得到焦点<br />     <br />     <br />     Dim Pnt1 As Variant<br />     Dim entObj1 As AcadEntity<br />     acaddoc.Utility.GetEntity entObj1, Pnt1, "选择修剪边界："<br />     Dim det1 As String<br />     det1 = axEnt2lspEnt(entObj1)<br />     <br />     Dim entObjOff As AcadEntity<br />     Dim entObjOffs As Variant<br />     <br />     '控制偏移的距离和方向的参数<br />     Dim OffDist As Double<br />     OffDist = 0.5<br />     entObjOffs = entObj1.Offset(OffDist)<br />     Set entObjOff = entObjOffs(0)<br />     <br /> <br />     Dim Pnt2 As Variant<br />     Dim entObj2 As AcadEntity<br />     <br />     Dim sle1 As AcadSelectionSet<br />     <br />     <br />     On Error Resume Next<br />     <br />     Set sle1 = acaddoc.SelectionSets.Item("sle1")<br />     sle1.Clear<br />     If Err Then<br />     Err.Clear<br />     Set sle1 = acaddoc.SelectionSets.Add("sle1")<br />     End If<br />     <br />     acaddoc.Utility.Prompt "选择需要修剪的对象" & Chr(13)<br />     <br />     sle1.SelectOnScreen<br />     <br />     'Pnt2 = acaddoc.Utility.GetPoint(, "选择修剪方向")<br />     Dim det2 As String<br />     <br />     Dim IntPnt As Variant<br />     Dim IntPnt1(2) As Double<br />     Dim n As Integer<br />     For Each entObj2 In sle1<br />     IntPnt = entObj2.IntersectWith(entObjOff, acExtendNone)<br />     <br />     If IsArray(IntPnt) Then<br />         For n = 0 To UBound(IntPnt) Step 3<br />             IntPnt1(0) = IntPnt(n + 0)<br />             IntPnt1(1) = IntPnt(n + 1)<br />             IntPnt1(2) = IntPnt(n + 2)<br />             det2 = GetDoubleEntTable(entObj2, IntPnt1)<br />             acaddoc.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr<br />         Next<br />     End If<br />     Next<br />     <br />     entObjOff.Delete<br />    <br />     Dim command_str As String<br />     command_str = Chr(3) & Chr(3)<br />     acaddoc.SendCommand command_str<br />     acaddoc.Utility.Prompt "修剪完成!"<br />     acaddoc.SendCommand command_str<br />     <br />     'Set acadapp = Nothing<br />     End<br />     <br /> <br /> End Sub<br /> <br /> '转换双元表的函数<br /> <br /> Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String<br />     Dim entHandle As String<br />     entHandle = entObj.Handle<br />     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _<br />                      ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"<br /> End Function<br /> <br /> '转换点的函数<br /> <br /> Public Function axPoint2lspPoint(Pnt As Variant) As String<br />     axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)<br /> End Function<br /> <br /> '转换图元函数<br /> <br /> Public Function axEnt2lspEnt(entObj As AcadEntity) As String<br />     Dim entHandle As String<br />     entHandle = entObj.Handle<br />     axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"<br /> End Function<br /> <br /> <br /> Function connectcad(acadapp As AcadApplication) As AcadApplication '连接AUTOCAD<br /> <br /> <br /> On Error Resume Next<br />      <br />     '与autocad通信<br />      <br />     Set acadapp = GetObject(, "AutoCAD.Application")<br />     If Err Then<br />         Err.Clear<br />         Set acadapp = CreateObject("AutoCAD.Application")<br />         If Err Then<br />             MsgBox Err.Description<br />             Exit Function<br />         End If<br />     End If<br /> Set connectcad = acadapp<br /> End Function<br /> <br /> 'Private Sub Form_Initialize()<br /> 'Trim<br /> 'End Sub<br />

以下为程序运行后的效果

cgzabcd12345

为什么你这个方法有些线不能剪掉，或者剪掉了相反的部分