form1.vb

基于vb.net的autocad二次开发关于图形动态装拆模拟能使二维图形三维图形三维曲面绘制spline样条曲线路径往复运动

Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows 窗体设计器生成的代码 "

    Public Sub New()
        MyBase.New()

        '该调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        '在 InitializeComponent() 调用之后添加任何初始化

    End Sub

    '窗体重写处置以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Windows 窗体设计器所必需的
    Private components As System.ComponentModel.IContainer

    '注意：以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器修改此过程。
    '不要使用代码编辑器修改它。
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents Button2 As System.Windows.Forms.Button
    Friend WithEvents Button3 As System.Windows.Forms.Button
    Friend WithEvents Button4 As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.Button1 = New System.Windows.Forms.Button()
        Me.Button2 = New System.Windows.Forms.Button()
        Me.Button3 = New System.Windows.Forms.Button()
        Me.Button4 = New System.Windows.Forms.Button()
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(32, 8)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(136, 32)
        Me.Button1.TabIndex = 9
        Me.Button1.Text = "Button1"
        '
        'Button2
        '
        Me.Button2.Location = New System.Drawing.Point(32, 56)
        Me.Button2.Name = "Button2"
        Me.Button2.Size = New System.Drawing.Size(136, 32)
        Me.Button2.TabIndex = 10
        Me.Button2.Text = "Button2"
        '
        'Button3
        '
        Me.Button3.Location = New System.Drawing.Point(32, 104)
        Me.Button3.Name = "Button3"
        Me.Button3.Size = New System.Drawing.Size(136, 32)
        Me.Button3.TabIndex = 11
        Me.Button3.Text = "Button3"
        '
        'Button4
        '
        Me.Button4.Location = New System.Drawing.Point(32, 152)
        Me.Button4.Name = "Button4"
        Me.Button4.Size = New System.Drawing.Size(136, 32)
        Me.Button4.TabIndex = 14
        Me.Button4.Text = "Button4"
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(200, 205)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Button4, Me.Button3, Me.Button2, Me.Button1})
        Me.Name = "Form1"
        Me.Text = "Form1"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Dim Acadapp As AutoCAD.AcadApplication

    Dim Obj() As AutoCAD.AcadObject '图形中实体
    Dim ObjCount As Integer '图形中实体的数目
    Dim ObjHandle() As String '图形中实体的Handle值

    Dim Objpath() As AutoCAD.AcadSpline '实体移动Spline路径
    Dim ObjpathCount As Integer '实体移动路径的数目
    Dim ObjpathHandle() As String '实体移动路径的Handle值

    Dim path As String '移动路径的类型，等于“拆卸”或“装配”
    Dim first As Boolean '已经完成第一次动态模拟

    Dim addobj As Integer '动态模拟后、添加了若干需要动态模拟的实体之前的实体数

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Me.Text = "实例33图形动态装拆模拟"

        Me.Button1.Text = "选择实体"
        Me.Button2.Text = "选择移动路径"
        Me.Button3.Text = "拆卸动态模拟"
        Me.Button4.Text = "装配动态模拟"

        ObjCount = -1
        ObjpathCount = -1
        addobj = -1
        first = False

        Call 连接AutoCAD()

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call 选择实体()
    End Sub

    Sub 选择实体()

        On Error Resume Next

        AppActivate(Acadapp.Caption)

        ObjCount = ObjCount + 1
        ReDim Preserve Obj(ObjCount)

        Dim basePnt As Object

        '等待用鼠标从屏幕上选择一个实体
        Acadapp.ActiveDocument.Utility.GetEntity(Obj(ObjCount), basePnt, "选择实体")
        Obj(ObjCount).Highlight(True) '高亮显示被选中实体
        AppActivate(Me.Text) '立即显示Visual Basic.NET窗体


        '若未选中实体，GetEntity语句将产生一个错误，使Err.Number <> 0
        If Err.Number <> 0 Then
            Err.Clear()
            ObjCount = ObjCount - 1
            MsgBox("未选中零件，重选")
            Exit Sub
        End If

        ReDim Preserve ObjHandle(ObjCount)

        ObjHandle(ObjCount) = Obj(ObjCount).Handle '获得实体的Handle值

        '首次调用时，删除以前的数据文件
        If ObjCount = 0 Then
            Kill(Application.StartupPath + "\*.txt")
        End If

        Dim i As Integer

        '打开“选择实体.txt”文件，写入实体的Handle值
        FileOpen(1, Application.StartupPath + "\选择实体.txt", OpenMode.Output)
        For i = 0 To ObjCount
            Write(1, ObjHandle(i))
        Next
        FileClose(1)

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Call 选择移动路径()

    End Sub

    Sub 选择移动路径()

        On Error Resume Next

        AppActivate(Acadapp.Caption)

        ObjpathCount = ObjpathCount + 1
        ReDim Preserve Objpath(ObjpathCount)

        Dim basePnt As Object

        '等待用鼠标从屏幕上选择一个实体
        Acadapp.ActiveDocument.Utility.GetEntity(Objpath(ObjpathCount), basePnt, "选择实体")
        Objpath(ObjpathCount).Highlight(True) '高亮显示被选中实体
        AppActivate(Me.Text) '立即显示Visual Basic.NET窗体


        '若未选中Spline路径，GetEntity语句将产生一个错误，使Err.Number <> 0
        If Err.Number <> 0 Then
            Err.Clear()
            ObjpathCount = ObjpathCount - 1
            MsgBox("未选中Spline路径，重选")
            Exit Sub
        End If



        ObjpathHandle(ObjpathCount) = Objpath(ObjpathCount).Handle '获得路径的Handle值

        Dim i As Integer

        '打开第ObjpathCount个“拆卸”文件，写入路径上各点的坐标
        FileOpen(1, Application.StartupPath + "\拆卸" + CStr(ObjpathCount) + ".txt", OpenMode.Output)
        For i = 0 To Objpath(ObjpathCount).NumberOfFitPoints - 1
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(0))
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(1))
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(2))
        Next
        FileClose(1)

        '打开第ObjpathCount个“装配”文件，写入路径上各点的坐标，它是“拆卸”路径的反顺序点
        FileOpen(1, Application.StartupPath + "\装配" + CStr(ObjpathCount) + ".txt", OpenMode.Output)
        For i = Objpath(ObjpathCount).NumberOfFitPoints - 1 To 0 Step -1
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(0))
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(1))
            Write(1, Objpath(ObjpathCount).GetFitPoint(i)(2))
        Next
        FileClose(1)

        '写入路径数目
        FileOpen(1, Application.StartupPath + "\路径数目.txt", OpenMode.Output)
        Write(1, ObjpathCount)
        FileClose(1)

        Me.Button3.Enabled = True
        Me.Button4.Enabled = True
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If first = False Then
            Call 识别实体对象()
            first = True
        End If

        path = "拆卸"

        Call 动态模拟()
        Me.Button3.Enabled = False
        Me.Button4.Enabled = True
    End Sub

    Sub 识别实体对象()


        AppActivate(Acadapp.Caption) '显示AutoCAD界面
        ObjCount = -1
        FileOpen(1, Application.StartupPath + "\选择实体.txt", OpenMode.Input)
        Do Until EOF(1)
            ObjCount = ObjCount + 1
            ReDim Preserve ObjHandle(ObjCount)
            Input(1, ObjHandle(ObjCount)) '将文件中实体的Handle值赋给数组
        Loop
        FileClose(1)

        ReDim Preserve Obj(ObjCount)
        Dim i As Integer

        '遍历模型空间，将每个实体的Handle值与文件中实体的Handle值比较，识别该实体为第几个运动实体
        Dim returnObj As AutoCAD.AcadObject
        For Each returnObj In Acadapp.ActiveDocument.ModelSpace
            For i = 0 To ObjCount
                If returnObj.Handle = ObjHandle(i) Then
                    Obj(i) = returnObj
                End If
            Next
        Next

    End Sub

    Sub 动态模拟()
        AppActivate(Acadapp.Caption) '显示AutoCAD界面

        '检查选择的零件数与路径数是否相等
        FileOpen(1, Application.StartupPath + "\路径数目.txt", OpenMode.Input)
        Input(1, ObjpathCount)
        FileClose(1)

        If ObjCount < ObjpathCount Then
            AppActivate(Me.Text) '立即显示Visual Basic.NET窗体
            MsgBox("零件少于路径数，增选零件")
            Exit Sub
        ElseIf ObjCount > ObjpathCount Then
            AppActivate(Me.Text) '立即显示Visual Basic.NET窗体
            MsgBox("路径少于零件数，增选路径")
            Exit Sub
        End If

        Dim formpoint(2), topoint(2) As Double
        Dim i As Integer

        Dim a, b, c As Integer

        '若为拆卸演示
        If path = "拆卸" Then
            a = 0
            b = ObjCount
            c = 1
            '若为装配演示
        ElseIf path = "装配" Then
            a = ObjCount
            b = 0
            c = -1
        End If

        '动态模拟后、添加了若干需要动态模拟的实体，则只读对添加的实体进行拆卸
        If addobj < ObjCount And addobj <> -1 Then
            a = addobj + 1
            b = ObjCount
            c = 1
        End If

        addobj = ObjCount

        For i = a To b Step c
            '第i条路径的各点坐标
            FileOpen(1, Application.StartupPath + "\" + path + CStr(i) + ".txt", OpenMode.Input)

            Input(1, topoint(0))
            Input(1, topoint(1))
            Input(1, topoint(2))

            formpoint(0) = topoint(0)
            formpoint(1) = topoint(1)
            formpoint(2) = topoint(2)
            Obj(i).move(formpoint, topoint)
            Obj(i).update()


            '读取文件号1中的数据，直到读完所有数据
            Do Until EOF(1)

                '实体移动的结束位置坐标
                Input(1, topoint(0))
                Input(1, topoint(1))
                Input(1, topoint(2))

                '第i个实体沿路径上各点运动
                Obj(i).move(formpoint, topoint)
                Obj(i).update()

                formpoint(0) = topoint(0)
                formpoint(1) = topoint(1)
                formpoint(2) = topoint(2)

            Loop
            FileClose(1)
        Next
        AppActivate(Me.Text) '立即显示Visual Basic.NET窗体
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        If first = False Then
            Call 识别实体对象()
            first = True
        End If

        path = "装配"

        Call 动态模拟()
        Me.Button4.Enabled = False
        Me.Button3.Enabled = True
    End Sub

    Sub 连接AutoCAD()
        On Error Resume Next
        Acadapp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
            Acadapp = CreateObject("AutoCAD.Application")
            If Err.Number Then
                MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD")
                Exit Sub
            End If
        End If
        Acadapp.Visible = True '界面可视
        Acadapp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(Acadapp.Caption) '显示AutoCAD界面

    End Sub

End Class