田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID
-随机-|-分布-
-博客论坛-|-﨣﨤﨧﨨-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2024 - 3 48
     12
3456789
10111213141516
17181920212223
24252627282930
31


站点统计

最新评论



隐藏日志,无权浏览 AutoCAD 的 ARX和DLL文件如何使用.LSP
未知 AutoCAD.net 实体沿曲线轨迹移动   [ 日期:2010-11-16 ]   [ 来自:代码转换 ]  HTML
代码有C#转换而来,原文来自http://www.objectarx.net/foru ... wthread&tid=4018
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Public Class 实体移动
    <CommandMethod("EntMove")> _
        Public Sub EntMove()
        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        '选择轨迹
        Dim opt As New PromptEntityOptions("选择轨迹")
        opt.SetRejectMessage(vbLf & "选择轨迹")
        opt.AddAllowedClass(GetType(Ellipse), True)
        opt.AddAllowedClass(GetType(Arc), True)
        opt.AddAllowedClass(GetType(Circle), True)
        opt.AddAllowedClass(GetType(Line), True)
        opt.AddAllowedClass(GetType(Polyline), True)
        opt.AddAllowedClass(GetType(Spline), True)
        Dim res As PromptEntityResult = ed.GetEntity(opt)
        If res.Status = PromptStatus.OK Then
            Using trans As Transaction = db.TransactionManager.StartTransaction()
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                Dim ent As Entity = TryCast(trans.GetObject(res.ObjectId, OpenMode.ForRead), Entity)
                '创建沿轨迹运行的实体
                Dim c As Curve = TryCast(ent, Curve)
                If c IsNot Nothing Then
                    Dim p As New DBPoint()
                    p.ColorIndex = 1
                    p.Position = c.StartPoint
                    btr.AppendEntity(p)
                    trans.AddNewlyCreatedDBObject(p, True)
                    trans.Commit()
                    ed.UpdateScreen()
                    System.Threading.Thread.Sleep(1000)
                    Dim pt As Point3d = Point3d.Origin
                    Dim k As Integer = 0
                    While pt <> c.EndPoint
                        Try
                            k += 1
                            pt = c.GetPointAtDist(40.0 * k)
                            '实体运行的速度
                            AlongMove(c, p.ObjectId, pt)
                        Catch
                            pt = c.EndPoint
                        End Try
                    End While
                End If
            End Using
        End If
    End Sub
    Private Sub AlongMove(ByVal c As Curve, ByVal objId As ObjectId, ByVal pt As Point3d)
        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim p As DBPoint = TryCast(trans.GetObject(objId, OpenMode.ForWrite), DBPoint)
            Dim m As Matrix3d = Matrix3d.Displacement(p.Position.GetVectorTo(pt))
            p.TransformBy(m)
            trans.Commit()
            If p.Position = c.EndPoint Then
                Return
            End If
            ed.UpdateScreen()
            System.Threading.Thread.Sleep(100)
        End Using
    End Sub
End Class


[本日志由 tiancao1001 于 2010-11-25 04:31 PM 编辑]


暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:3*5=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©