为什么有时不能把我想修剪的哪一段修剪掉
我利用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）。 确实有这问题，ACAD还判断它的位置在那一边，因而通过传递对象就不行了，使用SSGet来选择过一点的实体吧。
ThisDrawing.SendCommand "Trim" & vbCr & "(handent """ & EntObj1.Handle & """)" & vbCr _
& vbCr & "(ssget '(" & Format(pPt(0), "0.0000") & " " & Format(pPt(1), "0.0000") & "))" & vbCr & vbCr 明总写过一个关于trim和break的程序，我原来用过，是可以的。关键在于传递被剪切的对象时要使用双元表函数。
'示例Break
Sub Break()
Dim Pnt As Variant
Dim entObj As AcadEntity
ThisDrawing.Utility.GetEntity entObj, Pnt, "选择图元："
Dim Pnt2 As Variant
Pnt2 = ThisDrawing.Utility.GetPoint(, "选择点：")
Dim det As String
det = GetDoubleEntTable(entObj, Pnt)
Dim lspPnt As String
lspPnt = axPoint2lspPoint(Pnt2)
ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr
End Sub
'示例Trim
Sub Trim()
Dim Pnt1 As Variant
Dim entObj1 As AcadEntity
ThisDrawing.Utility.GetEntity entObj1, Pnt1, "选择图元："
Dim det1 As String
det1 = axEnt2lspEnt(entObj1)
Dim Pnt2 As Variant
Dim entObj2 As AcadEntity
ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择被剪图元："
Dim det2 As String
det2 = GetDoubleEntTable(entObj2, Pnt2)
ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
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
谢谢拉，你们真厉害 转换双元表的函数：
(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
三个坐标值间应加空格，否则Pnt(1)或Pnt(2)为负会出错！
页:
[1]