[求助]自动修剪

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

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

sh5ztc5bxku.JPG

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