现在把主要的一段代码贴上来， 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
‘外扩函数’
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
‘圆弧段转成多边形的函数’，英文很差，中文写的顺手
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
感谢分享程序 收费的，给个源码学习一下，大家共同提高
页:
[1]
2