VB.net进行CAD二次开发（二）与cad交互

开发过程遇到了一个问题：自制窗口与控件与CAD的交互。

启动类，调用非模式窗口

Imports Autodesk.AutoCAD.Runtime

Public Class Class1

    '//CAD启动界面
    <CommandMethod("US")>
    Public Sub UiStart()

        Dim myfrom As Form1 = New Form1()
        'Autodesk.AutoCAD.ApplicationServices.Application.ShowModalDialog(myfrom); //  模态显示
        '; //  非模态显示
        Autodesk.AutoCAD.ApplicationServices.Application.ShowModelessDialog(myfrom)

    End Sub
End Class

非模式窗体

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Linq
Imports System.Text
Imports System.Threading.Tasks
Imports System.Windows.Forms

Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports System.Runtime.InteropServices
Imports Application = Autodesk.AutoCAD.ApplicationServices.Application
Public Class Form1

    Dim db As Database = HostApplicationServices.WorkingDatabase
    Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
    Dim doc As Document = Application.DocumentManager.MdiActiveDocument

    Public Property MyDoc() As Document
        Get
            Return doc
        End Get
        Set(ByVal value As Document)
            doc = value
        End Set
    End Property

'调用windows all的命令，两种方法都可以
    ' <DllImport("user32.DLL")> _
    '  Public Shared Function SetFocus(ByVal hWnd As IntPtr) As Integer

    'End Function

    Public Declare Function SetFocus Lib "USER32.DLL" (ByVal hWnd As Integer) As Integer

    Public Sub New()
        InitializeComponent()
        SetFocus(doc.Window.Handle)
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        ed.WriteMessage("欢迎使用批量统计线段长度小工具，请框选线段！\n")

        '在界面开发中，操作图元时，首先进行文档锁定 ，利用using 语句变量作用范围，结束时自动解锁文档
        Using docLock As DocumentLock = doc.LockDocument()
            '过滤删选条件设置 过滤器
            Dim typedValues(0) As TypedValue
            typedValues.SetValue(New TypedValue(0, "*LINE"), 0)

            Dim sSet As SelectionSet = SelectSsGet("GetSelection", Nothing, typedValues)
            Dim sumLen As Double = 0
            ' 判断是否选取了对象
            If sSet IsNot Nothing Then
                '遍历选择集
                For Each sSObj As SelectedObject In sSet
                    ' 确认返回的是合法的SelectedObject对象  
                    If sSObj IsNot Nothing Then

                        '开启事务处理
                        Using trans As Transaction = db.TransactionManager.StartTransaction()
                            Dim curEnt As Curve = trans.GetObject(sSObj.ObjectId, OpenMode.ForRead)
                            ' 调整文字位置点和对齐点
                            Dim endPoint As Point3d = curEnt.EndPoint
                            'GetDisAtPoint 用于返回起点到终点的长度 传入终点坐标
                            Dim lineLength As Double = curEnt.GetDistAtPoint(endPoint)
                            ed.WriteMessage("\n" + lineLength.ToString())
                            sumLen = sumLen + lineLength
                            trans.Commit()
                        End Using
                    End If
                Next
            End If         'using 语句 结束，括号内所有对象自动销毁，不需要手动dispose()去销毁
            ed.WriteMessage("\n 线段总长为： " & (sumLen.ToString()))
        End Using
    End Sub

    Public Function SelectSsGet(ByVal selectStr As String, ByVal point3dCollection As Point3dCollection, ByVal typedValue() As TypedValue) As SelectionSet

        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        '将过滤条件赋值给SelectionFilter对象
        Dim selfilter As SelectionFilter = Nothing
        If typedValue IsNot Nothing Then
            selfilter = New SelectionFilter(typedValue)
        End If
        ' 请求在图形区域选择对象

        Dim psr As PromptSelectionResult
        If selectStr = "GetSelection" Then  '提示用户从图形文件中选取对象

            psr = ed.GetSelection(selfilter)

        ElseIf (selectStr = "SelectAll") Then '选择当前空间内所有未锁定及未冻结的对象

            psr = ed.SelectAll(selfilter)

        ElseIf selectStr = "SelectCrossingPolygon" Then '选择由给定点定义的多边形内的所有对象以及与多边形相交的对象。多边形可以是任意形状，但不能与自己交叉或接触。

            psr = ed.SelectCrossingPolygon(point3dCollection, selfilter)

            '选择与选择围栏相交的所有对象。围栏选择与多边形选择类似，所不同的是围栏不是封闭的， 围栏同样不能与自己相交
        ElseIf selectStr = "SelectFence" Then

            psr = ed.SelectFence(point3dCollection, selfilter)

            '选择完全框入由点定义的多边形内的对象。多边形可以是任意形状，但不能与自己交叉或接触
        ElseIf selectStr = "SelectWindowPolygon" Then

            psr = ed.SelectWindowPolygon(point3dCollection, selfilter)

        ElseIf selectStr = "SelectCrossingWindow" Then  '选择由两个点定义的窗口内的对象以及与窗口相交的对象

            Dim point1 As Point3d = point3dCollection(0)
            Dim point2 As Point3d = point3dCollection(1)
            psr = ed.SelectCrossingWindow(point1, point2, selfilter)

        ElseIf selectStr = "SelectWindow" Then '选择完全框入由两个点定义的矩形内的所有对象。

            Dim point1 As Point3d = point3dCollection(0)
            Dim point2 As Point3d = point3dCollection(1)
            psr = ed.SelectCrossingWindow(point1, point2, selfilter)
        Else
            Return Nothing
        End If

        '// 如果提示状态OK，表示对象已选
        If psr.Status = PromptStatus.OK Then
            Dim sSet As SelectionSet = psr.Value
            ed.WriteMessage("Number of objects selected: " + sSet.Count.ToString() + "\n") '打印选择对象数量
            Return sSet
        Else
            ' 打印选择对象数量
            ed.WriteMessage("Number of objects selected 0 \n")
            Return Nothing
        End If

    End Function

End Class

参考文献

https://zhuanlan.zhihu.com/p/138579148

VB.NET自动操作其他程序(2)--声明DLL相关函数 - zs李四 - 博客园