等分曲线并标注

ObjectArx

1. <CommandMethod("testcut")> _
   
2.      Public Sub cut()
   
3.         Dim db As Database = HostApplicationServices.WorkingDatabase
   
4.         Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
   
5.         Dim ts As String = vbCr & "请选择线条（圆弧、直线或者多义线）："
   
6.         Dim opt As New PromptEntityOptions(ts)
   
7.         opt.SetRejectMessage(vbCr & "只能线条")
   
8.         opt.AddAllowedClass(GetType(Polyline), True)
   
9.         opt.AddAllowedClass(GetType(Arc), True)
   
10.         opt.AddAllowedClass(GetType(Line), True)
    
11.         Dim res As PromptEntityResult = ed.GetEntity(opt)
    
12.         If res.Status <> PromptStatus.OK Then
    
13.             ed.WriteMessage("用户自行退出！" & vbCr)
    
14.         Else
    
15.             '获取等分数
    
16.             Dim iop As New PromptIntegerOptions("指定等分段的数量：")
    
17.             iop.DefaultValue = 10
    
18.             Dim irt As PromptIntegerResult = ed.GetInteger(iop)
    
19.             Dim n As Integer
    
20.             If irt.Status <> PromptStatus.OK OrElse irt.Value < 2 Then
    
21.                 Return
    
22.             Else
    
23.                 n = irt.Value
    
24.             End If
    
25.             Dim entid As ObjectId = res.ObjectId
    
26.             Using trans As Transaction = db.TransactionManager.StartTransaction()
    
27.                 '得到拾取的对象
    
28.                 Dim ent As Entity = trans.GetObject(entid, OpenMode.ForRead)
    
29.                 Dim cv As Curve = DirectCast(trans.GetObject(ent.ObjectId, OpenMode.ForWrite), Curve)
    
30.                 Dim len As Double = cv.GetDistanceAtParameter(cv.EndParam)
    
31.                 Dim i As Integer
    
32.                 For i = 0 To n
    
33.                     Dim p As Point3d = cv.GetPointAtDist(i * len / n)
    
34.                     Dim kp As Object = cv.GetFirstDerivative(cv.GetParameterAtDistance(i * len / n))
    
35.                     Dim ka As Double = kp(1) / kp(0) - Math.PI / 2
    
36.                     Call AddText(p, "等分点" & CStr(i), 3, ka, 1, 1)
    
37.                 Next
    
38.                 trans.Commit()
    
39.             End Using
    
40.         End If
    
41.     End Sub
    
42.     ' 由插入点、文字内容、文字高度和倾斜角度创建单行文字的函数.
    
43.     Public Function AddText(ByVal position As Point3d, ByVal textString As String, ByVal height As Double, ByVal rotate As Double, ByVal dq As Integer, ByVal co As Integer) As ObjectId
    
44.         'position为文字位置，textstring为文字内容，height为文字高度，rotate为文字角度，dq为对齐方式,co为颜色
    
45.         Try
    
46.             Dim ent As New DBText()
    
47.             ent.Position = position
    
48.             ent.TextString = textString
    
49.             ent.Height = height
    
50.             ent.Rotation = rotate
    
51.             ent.ColorIndex = co
    
52.             Select Case dq
    
53.                 Case 0
    
54.                     ent.HorizontalMode = TextHorizontalMode.TextMid
    
55.                 Case 1
    
56.                     ent.HorizontalMode = TextHorizontalMode.TextLeft
    
57.                     ent.VerticalMode = TextVerticalMode.TextVerticalMid
    
58.             End Select
    
59.             ent.AlignmentPoint = position
    
60.             Dim entId As ObjectId = AppendEntity(ent)
    
61.             Return entId
    
62.         Catch
    
63.             ' 创建失败,则返回一个空的ObjectId.
    
64.             Dim nullId As ObjectId = ObjectId.Null
    
65.             Return nullId
    
66.         End Try
    
67.     End Function
    
68.     ' 将图形对象加入到模型空间的函数.
    
69.     Public Function AppendEntity(ByVal ent As Entity) As ObjectId
    
70.         Dim db As Database = HostApplicationServices.WorkingDatabase
    
71.         Dim entId As ObjectId
    
72.         Using trans As Transaction = db.TransactionManager.StartTransaction
    
73.             Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
    
74.             Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
    
75.             entId = btr.AppendEntity(ent)
    
76.             trans.AddNewlyCreatedDBObject(ent, True)
    
77.             trans.Commit()
    
78.         End Using
    
79.         Return entId
    
80.     End Function
    

<CommandMethod("testcut")> _<br />      Public Sub cut()<br />         Dim db As Database = HostApplicationServices.WorkingDatabase<br />         Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor<br />         Dim ts As String = vbCr & "请选择线条（圆弧、直线或者多义线）："<br />         Dim opt As New PromptEntityOptions(ts)<br />         opt.SetRejectMessage(vbCr & "只能线条")<br />         opt.AddAllowedClass(GetType(Polyline), True)<br />         opt.AddAllowedClass(GetType(Arc), True)<br />         opt.AddAllowedClass(GetType(Line), True)<br />         Dim res As PromptEntityResult = ed.GetEntity(opt)<br />         If res.Status <> PromptStatus.OK Then<br />             ed.WriteMessage("用户自行退出！" & vbCr)<br />         Else<br />             '获取等分数<br />             Dim iop As New PromptIntegerOptions("指定等分段的数量：")<br />             iop.DefaultValue = 10<br />             Dim irt As PromptIntegerResult = ed.GetInteger(iop)<br />             Dim n As Integer<br />             If irt.Status <> PromptStatus.OK OrElse irt.Value < 2 Then<br />                 Return<br />             Else<br />                 n = irt.Value<br />             End If<br />             Dim entid As ObjectId = res.ObjectId<br />             Using trans As Transaction = db.TransactionManager.StartTransaction()<br />                 '得到拾取的对象<br />                 Dim ent As Entity = trans.GetObject(entid, OpenMode.ForRead)<br />                 Dim cv As Curve = DirectCast(trans.GetObject(ent.ObjectId, OpenMode.ForWrite), Curve)<br />                 Dim len As Double = cv.GetDistanceAtParameter(cv.EndParam)<br />                 Dim i As Integer<br />                 For i = 0 To n<br />                     Dim p As Point3d = cv.GetPointAtDist(i * len / n)<br />                     Dim kp As Object = cv.GetFirstDerivative(cv.GetParameterAtDistance(i * len / n))<br />                     Dim ka As Double = kp(1) / kp(0) - Math.PI / 2<br />                     Call AddText(p, "等分点" & CStr(i), 3, ka, 1, 1)<br />                 Next<br />                 trans.Commit()<br />             End Using<br />         End If<br />     End Sub<br />     ' 由插入点、文字内容、文字高度和倾斜角度创建单行文字的函数.<br />     Public Function AddText(ByVal position As Point3d, ByVal textString As String, ByVal height As Double, ByVal rotate As Double, ByVal dq As Integer, ByVal co As Integer) As ObjectId<br />         'position为文字位置，textstring为文字内容，height为文字高度，rotate为文字角度，dq为对齐方式,co为颜色<br />         Try<br />             Dim ent As New DBText()<br />             ent.Position = position<br />             ent.TextString = textString<br />             ent.Height = height<br />             ent.Rotation = rotate<br />             ent.ColorIndex = co<br />             Select Case dq<br />                 Case 0<br />                     ent.HorizontalMode = TextHorizontalMode.TextMid<br />                 Case 1<br />                     ent.HorizontalMode = TextHorizontalMode.TextLeft<br />                     ent.VerticalMode = TextVerticalMode.TextVerticalMid<br />             End Select<br />             ent.AlignmentPoint = position<br />             Dim entId As ObjectId = AppendEntity(ent)<br />             Return entId<br />         Catch<br />             ' 创建失败,则返回一个空的ObjectId.<br />             Dim nullId As ObjectId = ObjectId.Null<br />             Return nullId<br />         End Try<br />     End Function<br />     ' 将图形对象加入到模型空间的函数.<br />     Public Function AppendEntity(ByVal ent As Entity) As ObjectId<br />         Dim db As Database = HostApplicationServices.WorkingDatabase<br />         Dim entId As ObjectId<br />         Using trans As Transaction = db.TransactionManager.StartTransaction<br />             Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)<br />             Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)<br />             entId = btr.AppendEntity(ent)<br />             trans.AddNewlyCreatedDBObject(ent, True)<br />             trans.Commit()<br />         End Using<br />         Return entId<br />     End Function<br />

wmz0211

老师：你这是定数等分，能不能写一个定距等分的程序，并在等分点上用“点对象”标注：谢谢了！