开发过程遇到了一个问题：自制窗口与控件与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李四 - 博客园
