[求助]自动修剪
各位友人：如何实现，自动修剪，只保留矩形内线段！烦请给个例子吧！顶，顶！ 这个简单，不知道你解决了没有，首先选定那个矩形，然后发送截断命令，用栏选，选取四个点比矩形大的四个点，就是再建一个矩形。 Set AcadApp = GetObject(, "AutoCAD.Application")
On Error GoTo ert
startpnt = AcadApp.ActiveDocument.Utility.GetPoint(, vbCrLf + "正在准备标注点" & j & "请输入点位：")
insertionpnt1(0) = startpnt(0) - 0.5: insertionpnt1(1) = startpnt(1) - 0.5: insertionpnt1(2) = startpnt(2):
Set obj_Text1 = AcadApp.ActiveDocument.ModelSpace.AddText(j, insertionpnt1, 1)
Set cice = AcadApp.ActiveDocument.ModelSpace.AddCircle(startpnt, rad)
Dim ae As AcadObject
ad = cice.Handle
Dim at As String
Set ab = AcadApp.ActiveDocument.ModelSpace.AddCircle(startpnt, rad)
point1(0) = startpnt(0): point1(1) = startpnt(1) - 1: point1(2) = startpnt(2)
point2(0) = startpnt(0) - 1: point2(1) = startpnt(1): point2(2) = startpnt(2)
point3(0) = startpnt(0): point3(1) = startpnt(1) + 1: point3(2) = startpnt(2)
point4(0) = startpnt(0) + 1: point4(1) = startpnt(1): point4(2) = startpnt(2)
Text1 = point1(0) & "," & point1(1)
Text2 = point2(0) & "," & point2(1)
Text3 = point3(0) & "," & point3(1)
Text4 = point4(0) & "," & point4(1)
Set ae = AcadApp.ActiveDocument.HandleToObject(ad)
at = "(handent " & Chr(34) & ad & Chr(34) & ")"
AcadApp.ActiveDocument.SendCommand "_trim" & vbCr & at & vbCr & vbCr & "f" & vbCr & Text1.Text & vbCr & Text2.Text & vbCr & Text3.Text & vbCr & Text4.Text & vbCr & vbCr & vbCr
我这个截取圆内的线段，你只需要把坐标改成比矩形大的坐标就行了，完全可以做到，我应用过的。
这个就是专门为你写的完整代码：运行时先选择一个矩形，右键即可完成你要的操作
Sub tttt()
Dim p As Variant
Dim ent As AcadEntity
Dim min, max As Variant
Dim a(0 To 2) As Double
Dim b(0 To 2) As Double
ThisDrawing.Utility.GetEntity ent, p, "请选择一个矩形："
ent.GetBoundingBox min, max
st3 min, min(0) - 0.001, min(1) - 0.001, 0
st3 max, max(0) + 0.001, max(1) + 0.001, 0
st3 a, min(0) - 0.001, max(1) + 0.001, 0
st3 b, max(0) + 0.001, min(1) - 0.001, 0
ThisDrawing.SendCommand "_trim" & vbCr & "(handent """ & ent.Handle & """)" & vbCr & vbCr & "f" & vbCr & min(0) & "," & min(1) & vbCr & a(0) & "," & a(1) & vbCr & max(0) & "," & max(1) & vbCr & b(0) & "," & b(1) & vbCr & min(0) & "," & min(1) & vbCr & vbCr & vbCr
ThisDrawing.SendCommand "_trim" & vbCr & "(handent """ & ent.Handle & """)" & vbCr & vbCr & "f" & vbCr & min(0) & "," & min(1) & vbCr & a(0) & "," & a(1) & vbCr & max(0) & "," & max(1) & vbCr & b(0) & "," & b(1) & vbCr & min(0) & "," & min(1) & vbCr & vbCr & vbCr
End Sub
判断选择实体的四个相交点，用ＢＲＥＡＫ截断，在把角点在该对象之外的所有线条ＤＥＬ就ＯＫ了，这样更方便一些
四楼主代码中的st3是指什么啊？？？？？？？？？？？？ 假如相反，我只保留矩形外的线段，删除矩形里的线段该怎么做啊？？？？？？？？？？ 希望nhy12345678给予回答啊！！！！！！！！！！！ 希望楼主能够及时回复，这个方法有个问题，当矩形斜过来的时候好像就不起作用了！！！！！！！！！！！！！！！！！！！！！！！
页:
[1]