仅仅做一点小小修改
'绘制自定义多线
<CommandMethod("MYPOLY")> _
Public Sub MyPoly()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim col As Color = doc.Database.Cecolor
Dim pts As New Point3dCollection()
Dim opt As New PromptPointOptions(vbLf & "Select polyline vertex: ")
opt.AllowNone = True
Dim res As PromptPointResult = ed.GetPoint(opt)
While res.Status = PromptStatus.OK
pts.Add(res.Value)
opt.UseBasePoint = True
opt.BasePoint = res.Value
res = ed.GetPoint(opt)
If res.Status = PromptStatus.OK Then
ed.DrawVector(pts(pts.Count - 1), res.Value, col.ColorIndex, False)
End If
End While
If res.Status = PromptStatus.None Then
Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem
Dim origin As New Point3d(0, 0, 0)
Dim normal As New Vector3d(0, 0, 1)
normal = normal.TransformBy(ucs)
Dim plane As New Plane(origin, normal)
Dim pline As New Polyline(pts.Count)
pline.Normal = normal
For Each pt As Point3d In pts
Dim transformedPt As Point3d = pt.TransformBy(ucs)
pline.AddVertexAt(pline.NumberOfVertices, plane.ParameterOf(transformedPt), 0, 0, 0)
Next
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
Dim plineId As ObjectId = btr.AppendEntity(pline)
tr.AddNewlyCreatedDBObject(pline, True)
For Each ent As Entity In pline.GetOffsetCurves(-44.7)
btr.AppendEntity(ent)
tr.AddNewlyCreatedDBObject(ent, True)
Next
For Each ent As Entity In pline.GetOffsetCurves(-51)
btr.AppendEntity(ent)
tr.AddNewlyCreatedDBObject(ent, True)
Next
tr.Commit()
End Using
End If
End Sub
<CommandMethod("MYPOLY")> _
Public Sub MyPoly()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim col As Color = doc.Database.Cecolor
Dim pts As New Point3dCollection()
Dim opt As New PromptPointOptions(vbLf & "Select polyline vertex: ")
opt.AllowNone = True
Dim res As PromptPointResult = ed.GetPoint(opt)
While res.Status = PromptStatus.OK
pts.Add(res.Value)
opt.UseBasePoint = True
opt.BasePoint = res.Value
res = ed.GetPoint(opt)
If res.Status = PromptStatus.OK Then
ed.DrawVector(pts(pts.Count - 1), res.Value, col.ColorIndex, False)
End If
End While
If res.Status = PromptStatus.None Then
Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem
Dim origin As New Point3d(0, 0, 0)
Dim normal As New Vector3d(0, 0, 1)
normal = normal.TransformBy(ucs)
Dim plane As New Plane(origin, normal)
Dim pline As New Polyline(pts.Count)
pline.Normal = normal
For Each pt As Point3d In pts
Dim transformedPt As Point3d = pt.TransformBy(ucs)
pline.AddVertexAt(pline.NumberOfVertices, plane.ParameterOf(transformedPt), 0, 0, 0)
Next
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
Dim plineId As ObjectId = btr.AppendEntity(pline)
tr.AddNewlyCreatedDBObject(pline, True)
For Each ent As Entity In pline.GetOffsetCurves(-44.7)
btr.AppendEntity(ent)
tr.AddNewlyCreatedDBObject(ent, True)
Next
For Each ent As Entity In pline.GetOffsetCurves(-51)
btr.AppendEntity(ent)
tr.AddNewlyCreatedDBObject(ent, True)
Next
tr.Commit()
End Using
End If
End Sub
[本日志由 tiancao1001 于 2010-11-25 04:30 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |