田草博客

互联网田草博客


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

微信 公众号:ByCAD

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

用户登陆
用户:
密码:
 

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


站点统计

最新评论



C# 用SharpZipLib实现加密压缩、加密解压 InStr、IndexOf不一样,一个是从1开始一个是0开始
未知 动态拖拽圆角   [ 日期:2020-07-19 ]   [ 来自:转帖 ]  HTML
程序代码:

Imports System
Imports System.Text
Imports System.Linq
Imports System.Xml
Imports System.Reflection
Imports System.ComponentModel
Imports System.Collections
Imports System.Collections.Generic

Imports System.IO

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows

Imports MgdAcApplication = Autodesk.AutoCAD.ApplicationServices.Application
Imports MgdAcDocument = Autodesk.AutoCAD.ApplicationServices.Document
Imports AcWindowsNS = Autodesk.AutoCAD.Windows


Namespace AcadNetAddinWizard_Namespace
    Public Class FilletJigger
        Inherits EntityJig
        'region Fields

        Public mCurJigFactorIndex As Integer = 1

        Private mBasePoint As New Point3d()
        Private mNewPoint As Point3d
        ' Factor #1
        Public mOriginalVertices As Point2dCollection

        'endregion

        'region Constructors

        Public Sub New(ByVal ent As Entity, ByVal basePoint As Point3d)
            MyBase.New(ent)
            mOriginalVertices = New Point2dCollection()
            Dim i As Integer = 0
            While i < PLine.NumberOfVertices
                mOriginalVertices.Add(PLine.GetPoint2dAt(i))
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While

            mNewPoint = basePoint.TransformBy(UCS)
            mBasePoint = basePoint.TransformBy(UCS)
        End Sub

        'endregion

        'egion Properties

        Private ReadOnly Property Editor() As Editor
            Get
                Return MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
            End Get
        End Property

        Private ReadOnly Property UCS() As Matrix3d
            Get
                Return Editor.CurrentUserCoordinateSystem
            End Get
        End Property

        Private ReadOnly Property PLine() As Polyline
            Get
                Return TryCast(Entity, Polyline)
            End Get
        End Property

        'endregion

        'region Overrides

        Protected Overrides Function Update() As Boolean
            Dim dist As Double = mBasePoint.DistanceTo(mNewPoint)
            Dim ptCol As New Point2dCollection()
            Dim i As Integer = 0
            While i < mOriginalVertices.Count
                Dim current As Point2d = mOriginalVertices(i)
                Dim previous As Point2d = If(i = 0, mOriginalVertices(mOriginalVertices.Count - 1), mOriginalVertices(i - 1))
                Dim [next] As Point2d = If(i = mOriginalVertices.Count - 1, mOriginalVertices(0), mOriginalVertices(i + 1))

                Dim pt1 As Point2d = current + (previous - current) / current.GetDistanceTo(previous) * dist
                Dim pt2 As Point2d = current + ([next] - current) / current.GetDistanceTo([next]) * dist
                ptCol.Add(pt1)
                ptCol.Add(pt2)
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While

            Dim j As Integer = 0
            While j < PLine.NumberOfVertices
                PLine.SetPointAt(j, ptCol(j))
                System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
            End While
            Dim m As Integer = PLine.NumberOfVertices
            While m < ptCol.Count
                PLine.AddVertexAt(m, ptCol(m), 0, 0, 0)
                System.Math.Max(System.Threading.Interlocked.Increment(m), m - 1)
            End While

            Return True
        End Function

        Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
            Select Case mCurJigFactorIndex
                Case 1
                    Dim prOptions1 As New JigPromptPointOptions(vbLf & "Location:")
                    prOptions1.UserInputControls = UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
                    prOptions1.BasePoint = mBasePoint
                    prOptions1.UseBasePoint = True
                    Dim prResult1 As PromptPointResult = prompts.AcquirePoint(prOptions1)

                    If prResult1.Status = PromptStatus.Cancel Then
                        Return SamplerStatus.Cancel
                    End If

                    If prResult1.Value.Equals(mNewPoint) Then
                        'Use better comparision method if wanted.
                        Return SamplerStatus.NoChange
                    Else
                        mNewPoint = prResult1.Value
                        Return SamplerStatus.OK
                    End If
                Case Else
                    Exit Select
            End Select

            Return SamplerStatus.OK
        End Function

        'endregion

        'region Methods to Call

        Public Shared jigger As FilletJigger = Nothing
        Public Shared Function Jig(ByVal ent As Entity, ByVal basePt As Point3d) As Boolean
            Try
                jigger = New FilletJigger(ent, basePt)
                Dim pr As PromptResult
                Do
                    pr = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor.Drag(jigger)
                    ' Add keyword handling code below

                    If pr.Status = PromptStatus.Keyword Then
                    Else
                        System.Math.Max(System.Threading.Interlocked.Increment(jigger.mCurJigFactorIndex), jigger.mCurJigFactorIndex - 1)
                    End If
                Loop While pr.Status <> PromptStatus.Cancel AndAlso pr.Status <> PromptStatus.[Error] AndAlso jigger.mCurJigFactorIndex <= 1

                If pr.Status = PromptStatus.Cancel OrElse pr.Status = PromptStatus.[Error] Then
                    If jigger IsNot Nothing AndAlso jigger.Entity IsNot Nothing Then
                        jigger.Entity.Dispose()
                    End If

                    Return False
                Else
                    Return True
                End If
            Catch
                If jigger IsNot Nothing AndAlso jigger.Entity IsNot Nothing Then
                    jigger.Entity.Dispose()
                End If

                Return False
            End Try
        End Function
        'endregion

        'region Test Commands

        <CommandMethod("TestFilletJigger")> _
        Public Shared Sub TestFilletJigger_Method()
            Dim ed As Editor = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Try
                Dim selRes As PromptEntityResult = ed.GetEntity(vbLf & "Pick a polygon to fillet:")
                If selRes.Status = PromptStatus.OK Then
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        Dim ent As Entity = TryCast(tr.GetObject(selRes.ObjectId, OpenMode.ForWrite), Entity)
                        If ent IsNot Nothing AndAlso TypeOf ent Is Polyline AndAlso (CType(ent, Polyline)).Closed Then
                            If FilletJigger.Jig(ent, selRes.PickedPoint) Then
                                tr.Commit()
                            Else
                                tr.Abort()
                            End If
                        End If
                    End Using
                End If
            Catch ex As System.Exception
                ed.WriteMessage(ex.ToString())
            End Try
        End Sub
        'endregion
    End Class
End Namespace




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

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

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