一个简单的窗口截取程序

 ‘还在完善中------边上的虽然打断了，但没有删除掉

    <CommandMethod("T12")> Public Sub T12()

        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

        Try
            GetScaleRuler()

            Dim pt As New Point3d
            '存取点之记范围四周的坐标
            Dim ptColl As New Point3dCollection
            '和多边形相交的Curve
            Dim curs As New DBObjectCollection
            '打断后的曲线
            Dim curLast As New DBObjectCollection

            Dim ptOpt As New PromptPointOptions(vbCrLf & "请拾取需要生成点之记的位置")
            ptOpt.AllowNone = True
            Dim ptRes As PromptPointResult = ed.GetPoint(ptOpt)
            If ptRes.Status = PromptStatus.OK Then
                pt = ptRes.Value
                '获取点的x、y坐标
                Dim x As Double = pt.X
                Dim y As Double = pt.Y
                '计算范围线的四角坐标
                '西北角坐标
                Dim x1 As Double = x - 85 * ScaleFlector
                Dim y1 As Double = y + 60 * ScaleFlector
                '东北角坐标
                Dim x2 As Double = x + 85 * ScaleFlector
                Dim y2 As Double = y + 60 * ScaleFlector
                '东南角坐标
                Dim x3 As Double = x + 85 * ScaleFlector
                Dim y3 As Double = y - 60 * ScaleFlector
                '西南角坐标
                Dim x4 As Double = x - 85 * ScaleFlector
                Dim y4 As Double = y - 60 * ScaleFlector

                ptColl.Add(New Point3d(x1, y1, 0))
                ptColl.Add(New Point3d(x2, y2, 0))
                ptColl.Add(New Point3d(x3, y3, 0))
                ptColl.Add(New Point3d(x4, y4, 0))

                '添加图层
                Tools.AddLayer("点之记范围", 7)

                '绘制四边形
                Dim pLine As New Polyline
                pLine.AddVertexAt(0, New Point2d(x1, y1), 0, 0, 0)
                pLine.AddVertexAt(1, New Point2d(x2, y2), 0, 0, 0)
                pLine.AddVertexAt(2, New Point2d(x3, y3), 0, 0, 0)
                pLine.AddVertexAt(3, New Point2d(x4, y4), 0, 0, 0)

                pLine.Closed = True
                Tools.AppendEntity(pLine)
                '向外偏移
                Dim offsetcur As DBObjectCollection = pLine.GetOffsetCurves(-5)

                '开始当前文档的事务处理
                Using trans As Transaction = db.TransactionManager.StartTransaction
                    Dim resSel As PromptSelectionResult = ed.SelectCrossingPolygon(ptColl)
                    Dim sSet As SelectionSet = resSel.Value
                    Dim Ids As ObjectIdCollection = New ObjectIdCollection(sSet.GetObjectIds)
                    '先提取和范围相交的曲线
                    For Each id As ObjectId In Ids
                        Dim ent As Entity = trans.GetObject(id, OpenMode.ForWrite)
                        If TypeOf (ent) Is Curve = True Then
                            Dim cur1 As Curve
                            Dim pts As New Point3dCollection
                            cur1 = CType(ent, Curve)
                            '和多边形的交点
                            cur1.IntersectWith(pLine, Intersect.ExtendArgument, pts, 0, 0)
                            '如果相交
                            If pts.Count > 0 Then
                                curs.Add(cur1)
                            End If
                        End If
                    Next

                    '遍历相交的实体，并从交点处打断
                    For Each ent As DBObject In curs
                        Dim cur As Curve = trans.GetObject(ent.ObjectId, OpenMode.ForWrite)
                        '删除多边形
                        'If cur.ObjectId = pLine.ObjectId Then
                        'cur.Erase()
                        'Continue For
                        'End If

                        Dim pts As New Point3dCollection
                        cur.IntersectWith(pLine, Intersect.ExtendArgument, pts, 0, 0)
                        If pts.Count > 0 Then
                            '排序
                            Dim pts2 As New SortedList(Of Double, Point3d)

                            For Each ptX As Point3d In pts
                                pts2.Add(cur.GetParameterAtPoint(ptX), ptX)
                            Next
                            pts.Clear()
                            For i As Integer = 0 To pts2.Count - 1
                                pts.Add(pts2.Values(i))
                            Next
                            '得到打断的曲线
                            curLast = cur.GetSplitCurves(pts)
                            Dim noPtCurs As New DBObjectCollection
                            '遍历打断的Curve
                            For Each entX As DBObject In curLast
                                Dim curX As Curve = CType(entX, Curve)
                                Dim ptx As New Point3dCollection
                                curX.IntersectWith(offsetcur(0), Intersect.ExtendArgument, ptx, 0, 0)
                                '如果没有交点，则提取出来
                                If ptx.Count = 0 Then
                                    noPtCurs.Add(curX)
                                End If
                            Next
                            '绘制范围内的曲线
                            For t As Integer = 0 To noPtCurs.Count - 1
                                Tools.AppendEntity(noPtCurs.Item(t))
                            Next
                        End If
                        '删除原来没有打断的曲线
                        cur.Erase()
                    Next
                    trans.Commit()
                End Using
            End If

        Catch ex As Exception
            System.Windows.Forms.MessageBox.Show(ex.Message, "错误", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Error)
        End Try
    End Sub