为什么有时不能把我想修剪的哪一段修剪掉

miaoph

我利用SendCommand执行trim命令时，为什么有时不能把我想修剪的哪一段修剪掉，反而会把我想保留的哪一段修剪掉。我的程序的源代码如下：（这是efan2000斑竹提供给我的）
Sub test()
    Dim EntObj1 As AcadEntity
    Dim EntObj2 As AcadEntity
    Dim pPt As Variant
    ' 提示
    ThisDrawing.Utility.Prompt "选择剪切边..." & vbCr
    ' 选择对象
    ThisDrawing.Utility.GetEntity EntObj1, pPt, "选择对象:" & vbCr
    ' 亮显
    EntObj1.Highlight True
    ThisDrawing.Utility.GetEntity EntObj2, pPt, "选择要修剪的对象:" & vbCr
    EntObj1.Highlight True
    ' 判断是否为同一对象
    If EntObj1.Handle = EntObj2.Handle Then
        ThisDrawing.Utility.Prompt "对象重复" & vbCr
        ThisDrawing.Regen acActiveViewport
        Exit Sub
    End If
    ' 执行内部Trim命令，handent 通过句柄获取Lisp中的对象（实体）名称。
    ThisDrawing.SendCommand "Trim" & vbCr & "(handent """ & EntObj1.Handle & """)" & vbCr _
        & vbCr & "(handent """ & EntObj2.Handle & """)" & vbCr & vbCr
    ' 当前视图重生成
    ThisDrawing.Regen acActiveViewport
End Sub

莫名

程序有问题！
通过点选的办法实现（程序中的pPt）。

efan2000

确实有这问题，ACAD还判断它的位置在那一边，因而通过传递对象就不行了，使用SSGet来选择过一点的实体吧。

ThisDrawing.SendCommand "Trim" & vbCr & "(handent """ & EntObj1.Handle & """)" & vbCr _
        & vbCr & "(ssget '(" & Format(pPt(0), "0.0000") & " " & Format(pPt(1), "0.0000") & "))" & vbCr & vbCr

subtlation

明总写过一个关于trim和break的程序，我原来用过，是可以的。关键在于传递被剪切的对象时要使用双元表函数。

2. '示例Break
   
3. 
   
4. Sub Break()
   
5.     Dim Pnt As Variant
   
6.     Dim entObj As AcadEntity
   
7.     ThisDrawing.Utility.GetEntity entObj, Pnt, "选择图元："
   
8.     Dim Pnt2 As Variant
   
9.     Pnt2 = ThisDrawing.Utility.GetPoint(, "选择点：")
   
10. 
    
11.     Dim det As String
    
12.     det = GetDoubleEntTable(entObj, Pnt)
    
13. 
    
14.     Dim lspPnt As String
    
15.     lspPnt = axPoint2lspPoint(Pnt2)
    
16.     ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr
    
17. 
    
18. End Sub
    
19. 
    
20. '示例Trim
    
21. 
    
22. Sub Trim()
    
23. 
    
24.     Dim Pnt1 As Variant
    
25.     Dim entObj1 As AcadEntity
    
26.     ThisDrawing.Utility.GetEntity entObj1, Pnt1, "选择图元："
    
27.     Dim det1 As String
    
28.     det1 = axEnt2lspEnt(entObj1)
    
29. 
    
30.     Dim Pnt2 As Variant
    
31.     Dim entObj2 As AcadEntity
    
32.     ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择被剪图元："
    
33.     Dim det2 As String
    
34.     det2 = GetDoubleEntTable(entObj2, Pnt2)
    
35. 
    
36.     ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
    
37. 
    
38. End Sub
    
39. 
    
40. '转换双元表的函数
    
41. 
    
42. Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
    
43.     Dim entHandle As String
    
44.     entHandle = entObj.Handle
    
45.     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
    
46.                      ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
    
47. End Function
    
48. 
    
49. '转换点的函数
    
50. 
    
51. Public Function axPoint2lspPoint(Pnt As Variant) As String
    
52.     axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
    
53. End Function
    
54. 
    
55. '转换图元函数
    
56. 
    
57. Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    
58.     Dim entHandle As String
    
59.     entHandle = entObj.Handle
    
60.     axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
    
61. End Function
    

'示例Break<br /> <br /> Sub Break()<br />     Dim Pnt As Variant<br />     Dim entObj As AcadEntity<br />     ThisDrawing.Utility.GetEntity entObj, Pnt, "选择图元："<br />     Dim Pnt2 As Variant<br />     Pnt2 = ThisDrawing.Utility.GetPoint(, "选择点：")<br /> <br />     Dim det As String<br />     det = GetDoubleEntTable(entObj, Pnt)<br /> <br />     Dim lspPnt As String<br />     lspPnt = axPoint2lspPoint(Pnt2)<br />     ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr<br /> <br /> End Sub<br /> <br /> '示例Trim<br /> <br /> Sub Trim()<br /> <br />     Dim Pnt1 As Variant<br />     Dim entObj1 As AcadEntity<br />     ThisDrawing.Utility.GetEntity entObj1, Pnt1, "选择图元："<br />     Dim det1 As String<br />     det1 = axEnt2lspEnt(entObj1)<br /> <br />     Dim Pnt2 As Variant<br />     Dim entObj2 As AcadEntity<br />     ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择被剪图元："<br />     Dim det2 As String<br />     det2 = GetDoubleEntTable(entObj2, Pnt2)<br /> <br />     ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr<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 />

miaoph

谢谢拉，你们真厉害

tfyyf

转换双元表的函数：
(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
三个坐标值间应加空格，否则Pnt(1)或Pnt(2)为负会出错！