[求助]自动修剪

offloading

各位友人：如何实现，自动修剪，只保留矩形内线段！烦请给个例子吧！

robbin840311

顶，顶！

mary_99w

这个简单，不知道你解决了没有，首先选定那个矩形，然后发送截断命令，用栏选，选取四个点比矩形大的四个点，就是再建一个矩形。 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

我这个截取圆内的线段，你只需要把坐标改成比矩形大的坐标就行了，完全可以做到，我应用过的。

nhy12345678

这个就是专门为你写的完整代码：运行时先选择一个矩形，右键即可完成你要的操作

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

天龙八部

判断选择实体的四个相交点，用ＢＲＥＡＫ截断，在把角点在该对象之外的所有线条ＤＥＬ就ＯＫ了，这样更方便一些

kingzgh

四楼主代码中的st3是指什么啊？？？？？？？？？？？？

kingzgh

假如相反，我只保留矩形外的线段，删除矩形里的线段该怎么做啊？？？？？？？？？？

kingzgh

希望nhy12345678给予回答啊！！！！！！！！！！！

kingzgh

希望楼主能够及时回复，这个方法有个问题，当矩形斜过来的时候好像就不起作用了！！！！！！！！！！！！！！！！！！！！！！！