[求助]自动修剪

offloading 发表于 2009-2-7 09:42:00

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

robbin840311 发表于 2009-2-8 11:52:00

顶，顶！

mary_99w 发表于 2009-2-13 17:05:00

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

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

天龙八部 发表于 2009-2-14 10:59:00

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

kingzgh 发表于 2009-4-13 19:59:00

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

kingzgh 发表于 2009-4-13 20:06:00

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

kingzgh 发表于 2009-4-13 20:13:00

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

kingzgh 发表于 2009-4-18 10:27:00

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

页: [1]

明经CAD社区's Archiver

[求助]自动修剪