截取曲线内图形，并复制

king20061335

哎，我以为是源码呢。

ZZX4274382

没有原码也要钱啊，不带这样玩的

偶尔做做怪

过些日子上源码！暂时还在修改

j15tty

期待中！！！！！！！

630051689

论坛关了好久，终于又能上了
现在把主要的一段代码贴上来， Jig_Move这个类是参考才鸟数改写的库函数，主要是图形随鼠标拖动的效果！时间久了源码也丢了！大家也可以参考论坛里其他的文章



Public Sub BreakCurve_Select(Remain_original As Boolean)

        Dim dm As DocumentCollection = Application.DocumentManager
        Dim ed As Editor = dm.MdiActiveDocument.Editor
        '获取当前数据库作为目标数据库
        Dim Db As Database = dm.MdiActiveDocument.Database
        ' Dim 起始图形 As Entity
        Dim pl As Polyline
        Dim C1 As Circle
        Dim select_curve As Curve

        '拾取对象----------------------------------------------------------
        Dim optEnt As New PromptEntityOptions(vbCrLf & "请选择对象")
        Dim resEnt As PromptEntityResult = ed.GetEntity(optEnt)
        If resEnt.Status <> PromptStatus.OK Then Return

        Dim _curve As Curve  '定义需要被裁减的曲线
        Dim pts As Point3dCollection = New Point3dCollection '定义交点集合
        Dim pars As DoubleCollection = New DoubleCollection
        Dim objs As DBObjectCollection = New DBObjectCollection


        '定义过滤条件
        Dim value1 As TypedValue = New TypedValue(DxfCode.Start, "circle,arc,line,LWPOLYLINE,spline,ELLIPSE")
      
        Dim values() As TypedValue = {value1}
        Dim sfilter As New SelectionFilter(values)
        Dim resSel As PromptSelectionResult = ed.SelectAll(sfilter)

        Dim sSet As SelectionSet = resSel.Value
        '得到选择集中所有对象的ObjectId集合.
        Dim ids As ObjectId() = sSet.GetObjectIds()

        Dim objss As DBObjectCollection = New DBObjectCollection

        Using trans As Transaction = Db.TransactionManager.StartTransaction()

            select_curve = trans.GetObject(resEnt.ObjectId, OpenMode.ForRead)

            For Each id As ObjectId In ids  '遍历所有实体，排除裁剪框
                If id <> resEnt.ObjectId Then

                    _curve = trans.GetObject(id, OpenMode.ForWrite)
                    pts.Clear() '清空点坐标
                    pars.Clear() '清空点坐标
                    select_curve.IntersectWith(_curve, Intersect.OnBothOperands, pts, New IntPtr(0), New IntPtr(0)) '求交点 pts返回交点

                    If pts.Count <> 0 Then   '如果有交点就分割曲线

                        Dim PT(pts.Count - 1) As Point3d

                        For j As Integer = 0 To pts.Count - 1
                            pts(j) = _curve.GetClosestPointTo(pts(j), False)
                            pars.Add(_curve.GetDistAtPoint(pts(j)))
                            PT(j) = pts(j)
                            'MsgBox(pts(j).ToString)
                        Next
                        Array.Sort(pars.ToArray(), PT)
                        objs = _curve.GetSplitCurves(New Point3dCollection(PT)) '按交点分割CLONE曲线

                        For i As Integer = 0 To objs.Count - 1
                            objss.Add(objs.Item(i))
                            ' MsgBox(objs.Count)
                        Next

                        If Remain_original = False Then _curve.Erase()
                    End If
                End If
            Next

            For Each obj As Entity In objss
                函数库.AppendEntity(obj)
            Next

            trans.Commit()
        End Using

        '-----如果保留原曲线则移动图形，否则打断图形
        If Remain_original = True Then
            Using trans As Transaction = Db.TransactionManager.StartTransaction()

                Dim opl As Polyline = New Polyline
                Dim opll As Polyline = New Polyline '外扩线
                Dim ptss As Point3dCollection = New Point3dCollection

                If TypeOf select_curve Is Polyline Then
                    pl = CType(trans.GetObject(resEnt.ObjectId, OpenMode.ForRead), Polyline)

                    '如果是多段线  则先外扩再将圆弧转换

                    'opl = Off_Polyline(Curve2Polyline(pl, 4), 0.1)
                    Dim 外扩尺寸(4) As Double

                    外扩尺寸(0) = 0.001
                    外扩尺寸(1) = 0.5
                    外扩尺寸(2) = 1
                    外扩尺寸(3) = 5
                    外扩尺寸(4) = 10
                    Dim 标签 As Integer = 1

                    opll = Off_Polyline(pl, 外扩尺寸(标签))
                    函数库.AppendEntity(opll)
                    opl = Curve2Polyline(opll, 8)
                    opll.Erase()
                    '函数库.AppendEntity(opl)

                    For I As Integer = 0 To opl.NumberOfVertices - 1
                        ' MsgBox(pl.GetPoint2dAt(I).X.ToString & "----------" & pl.GetPoint2dAt(I).Y.ToString)
                        ptss.Add(opl.GetPoint3dAt(I))
                        ' MsgBox(ptss(I).ToString)
                    Next

                    Dim optSel As New PromptSelectionOptions

                    Dim Move_resSel As PromptSelectionResult = ed.SelectWindowPolygon(ptss)
                    If Move_resSel.Status <> PromptStatus.OK Then
                        ' 函数库.AppendEntity(opl)
                        MsgBox("x")
                        Return
                    End If


                    Dim Move_sSet As SelectionSet = Move_resSel.Value
                    Dim Move_ids As ObjectId() = Move_sSet.GetObjectIds()


                    Dim JM As Jig_Move
                    JM = New Jig_Move(Move_ids)
                    JM.AddObjID(resEnt.ObjectId)
                    JM.testJigCopy()


                ElseIf TypeOf select_curve Is Circle Then

                    C1 = CType(trans.GetObject(resEnt.ObjectId, OpenMode.ForRead), Circle)
                    '如果是圆形  先转换成多段线再外扩
                    opl = Off_Polyline(Curve2Polyline(C1, 1024), 0.1)

                    For I As Integer = 0 To opl.NumberOfVertices - 1
                        ' MsgBox(pl.GetPoint2dAt(I).X.ToString & "----------" & pl.GetPoint2dAt(I).Y.ToString)
                        ptss.Add(opl.GetPoint3dAt(I))
                    Next

                    Dim optSel As New PromptSelectionOptions
                    Dim Move_resSel As PromptSelectionResult = ed.SelectWindowPolygon(ptss)
                    If Move_resSel.Status <> PromptStatus.OK Then Return
                    Dim Move_sSet As SelectionSet = Move_resSel.Value
                    Dim Move_ids As ObjectId() = Move_sSet.GetObjectIds()

                   Dim JM As Jig_Move
                    JM = New Jig_Move(Move_ids)
                    JM.testJigCopy()

                End If

                trans.Commit()
            End Using

            '-----删除打断后的生成图形
            Using trans As Transaction = Db.TransactionManager.StartTransaction()
                For Each obj As Entity In objss
                    Dim ent As Entity = trans.GetObject(obj.ObjectId, OpenMode.ForWrite)
                    ent.Erase()
                Next
                trans.Commit()
            End Using
        End If

    End Sub
    <CommandMethod("BKM")> Public Sub BKS()

        BreakCurve_Select(True)

    End Sub

630051689

‘外扩函数’
Public Shared Function Off_Polyline(pl As Polyline, Dis As Double) As Polyline
        Dim off_cueve As Polyline = New Polyline

        Dim points As New List(Of Point2d)
        Dim PPP As Point2d
        For K As Integer = 0 To pl.NumberOfVertices - 1
            PPP = pl.GetPoint2dAt(K)
            points.Add(PPP)
        Next

        Dim 多边形方向 As CsharpClass.ClockDirection
        多边形方向 = CsharpClass.Polygon.CalculateClockDirection(points, False)

        If 多边形方向 = ClockDirection.Clockwise Then
            Dis = -Dis
            'MsgBox("顺")
        ElseIf 多边形方向 = ClockDirection.Counterclockwise Then
            Dis = Dis
            ' MsgBox("逆")
        ElseIf 多边形方向 = ClockDirection.None Then
            MsgBox("无法判断多边形方向")
        End If

        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim offsetCur As DBObjectCollection = pl.GetOffsetCurves(Dis)
        '将偏移的对象加入到数据库
        ' 函数库.AppendEntity(offsetCur(0))
        If TypeOf offsetCur(0) Is Polyline Then

            off_cueve = CType(offsetCur(0), Polyline)

        End If
        Return off_cueve

    End Function

630051689

‘圆弧段转成多边形的函数’，英文很差，中文写的顺手

Public Shared Function Curve2Polyline(_curve As Curve, precise As Double) As Polyline

        Dim pl As Polyline = New Polyline

        Dim dm As DocumentCollection = Application.DocumentManager
        Dim ed As Editor = dm.MdiActiveDocument.Editor
        '获取当前数据库作为目标数据库
        Dim Db As Database = dm.MdiActiveDocument.Database


        Using trans As Transaction = Db.TransactionManager.StartTransaction()

            If TypeOf trans.GetObject(_curve.ObjectId, OpenMode.ForRead) Is Circle Then
                Dim c1 As Circle = New Circle
                c1 = CType(trans.GetObject(_curve.ObjectId, OpenMode.ForRead), Circle)
                ' Dim 分割数 As Integer = c1.Circumference / precise
                Dim 棱边数 As Integer = 1024
                Dim 对角距 As Double = 函数库.求对角距(c1.Radius, 棱边数)
                Dim 角度 As Double = PI * 2 / 棱边数

                Dim pts(棱边数 - 1) As Point2d

                For i As Integer = 0 To 棱边数 - 1
                    pts(i) = New Point2d(c1.Center.X + 对角距 * Cos(角度 * i), c1.Center.Y + 对角距 * Sin(角度 * i))
                    pl.AddVertexAt(i, pts(i), 0, 0, 0)
                Next
                pl.Closed = True


            ElseIf TypeOf trans.GetObject(_curve.ObjectId, OpenMode.ForRead) Is Polyline Then

                Dim PLL As Polyline = New Polyline
                PLL = CType(trans.GetObject(_curve.ObjectId, OpenMode.ForRead), Polyline)

                '---------------判断多边形方向
                Dim points As New List(Of Point2d)
                Dim PPP As Point2d
                For K As Integer = 0 To PLL.NumberOfVertices - 1
                    PPP = PLL.GetPoint2dAt(K)
                    points.Add(PPP)
                Next

                Dim 多边形方向 As CsharpClass.ClockDirection
                多边形方向 = CsharpClass.Polygon.CalculateClockDirection(points, False)
                '--------------判断多边形方向

                Dim 凸度(-1) As Double
                Dim 凸起位置(-1) As Integer
                Dim 圆心(-1) As Point3d
                Dim N As Integer = -1
                Dim PLS(-1) As Polyline

                For i As Integer = 0 To PLL.NumberOfVertices - 1
                    pl.AddVertexAt(i, PLL.GetPoint2dAt(i), 0, 0, 0)
                    If PLL.GetBulgeAt(i) <> 0 Then
                        N = N + 1
                        ReDim Preserve 凸度(N)
                        ReDim Preserve 凸起位置(N)
                        ReDim Preserve 圆心(N)
                        ReDim Preserve PLS(N)
                        凸度(N) = PLL.GetBulgeAt(i)
                        凸起位置(N) = i
                    End If
                Next


                For J As Integer = N To 0 Step -1
                    Dim 起点 As Point2d '起点坐标
                    Dim 终点 As Point2d '终点坐标
                    Dim pC As Point3d '圆心坐标
                    '  Dim b As Double 'b=Bulge 凸度值
                    Dim L As Double 'L为弦长
                    Dim Lc As Double '弦心距（弦中心到圆弧中心的距离）
                    Dim R As Double '弧半径

                    起点 = PLL.GetPoint2dAt(凸起位置(J))

                    If 凸起位置(J) = PLL.NumberOfVertices - 1 Then
                        终点 = PLL.GetPoint2dAt(0)
                    Else
                        终点 = PLL.GetPoint2dAt(凸起位置(J) + 1)
                    End If

                    ' MsgBox(凸起位置(J).ToString & vbCrLf & 起点.ToString)
                    ' MsgBox(终点.ToString)
                    L = Sqrt((起点.X - 终点.X) ^ 2 + (起点.Y - 终点.Y) ^ 2)
                    R = 0.25 * L * (1 + 凸度(J) ^ 2) / 凸度(J)
                    Lc = 0.25 * L * (1 - 凸度(J) ^ 2) / 凸度(J)

                    ' pC.X = (起点.X + 终点.X) / 2 + Lc / L * (起点.Y - 终点.Y)
                    ' pC.Y = (起点.Y + 终点.Y) / 2 + Lc / L * (终点.X - 起点.X))
                    pC = New Point3d((起点.X + 终点.X) / 2 + Lc / L * (起点.Y - 终点.Y), _
                                     (起点.Y + 终点.Y) / 2 + Lc / L * (终点.X - 起点.X), 0)

                    Dim pts(precise - 1) As Point2d

                    Dim 总弧度 As Double = 4 * Atan(凸度(J))
                    Dim 角度 As Double = 总弧度 / precise
                    Dim 对角距 As Double = R / Cos(角度 / 2)
                    Dim 起点角度 As Double


                    起点角度 = 函数库.求线段绝对角度(函数库.p32d(pC), 起点)

                    PLS(J) = New Polyline

                    For K As Integer = 0 To precise - 1

                        '顺时针方向
                        If 多边形方向 = ClockDirection.Clockwise Then
                            pts(K) = New Point2d(pC.X + R * Cos(起点角度 + 角度 * K), pC.Y + R * Sin(起点角度 + 角度 * K))
                            If 凸度(J) < 0 Then
                                pts(K) = New Point2d(pC.X + 对角距 * Cos(起点角度 + 角度 / 2 + 角度 * K + PI), pC.Y + 对角距 * Sin(起点角度 + 角度 / 2 + 角度 * K + PI))
                            End If

                            '逆时针方向
                        ElseIf 多边形方向 = ClockDirection.Counterclockwise Then
                            pts(K) = New Point2d(pC.X + 对角距 * Cos(起点角度 + 角度 / 2 + 角度 * K), pC.Y + 对角距 * Sin(起点角度 + 角度 / 2 + 角度 * K))
                            If 凸度(J) < 0 Then
                                'pts(K) = New Point2d(pC.X + 对角距 * Cos(起点角度 + 角度 / 2 + 角度 * K + PI), pC.Y + 对角距 * Sin(起点角度 + 角度 / 2 + 角度 * K + PI))
                                pts(K) = New Point2d(pC.X + R * Cos(起点角度 + 角度 * K + PI), pC.Y + R * Sin(起点角度 + 角度 * K + PI))
                            End If

                        ElseIf 多边形方向 = ClockDirection.None Then
                            '按外接多边形考虑
                            pts(K) = New Point2d(pC.X + 对角距 * Cos(起点角度 + 角度 / 2 + 角度 * K), pC.Y + 对角距 * Sin(起点角度 + 角度 / 2 + 角度 * K))
                            If 凸度(J) < 0 Then
                                pts(K) = New Point2d(pC.X + 对角距 * Cos(起点角度 + 角度 / 2 + 角度 * K + PI), pC.Y + 对角距 * Sin(起点角度 + 角度 / 2 + 角度 * K + PI))
                                'pts(K) = New Point2d(pC.X + R * Cos(起点角度 + 角度 * K + PI), pC.Y + R * Sin(起点角度 + 角度 * K + PI))
                            End If
                        End If

                        PLS(J).AddVertexAt(K, pts(K), 0, 0, 0)
                    Next

                    PLS(J).ReverseCurve()

                    For k As Integer = 0 To precise - 1
                        pl.AddVertexAt(凸起位置(J) + 1, PLS(J).GetPoint2dAt(k), 0, 0, 0)
                    Next

                    ReMove_PlSaPt(pl)
                Next

                pl.Closed = True

            End If

            trans.Commit()
        End Using
   
        Return pl
    End Function

    Public Shared Function ReMove_PlSaPt(PLL As Polyline) As Polyline

        Dim PL As Polyline = New Polyline
        PL = PLL
        Dim 相同点(-1) As Integer
        Dim 计数器 As Integer = -1
        For M As Integer = 0 To PL.NumberOfVertices - 2  '移除相同点
            If PL.GetPoint3dAt(M) = PL.GetPoint3dAt(M + 1) Then
                计数器 = 计数器 + 1
                ReDim Preserve 相同点(计数器)
                相同点(计数器) = M
                'MsgBox(" SS" & 计数器)
            End If
        Next M
        For N As Integer = 计数器 To 0 Step -1
            PL.RemoveVertexAt(相同点(N))
            ' MsgBox(相同点(N))
        Next
        Return PL

    End Function

xyz002

感谢分享程序

mycad

收费的，给个源码学习一下，大家共同提高