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李四 - 博客园

相关推荐
Source.Liu2 小时前
【学Rust写CAD】20 平铺模式结构体(spread.rs)
rust·cad
Julian.zhou10 小时前
MCP服务:五分钟实现微服务治理革命,无缝整合Nacos/Zookeeper/OpenResty
人工智能·微服务·zookeeper·交互·openresty
计算机毕设定制辅导-无忧学长1 天前
HTML 与 JavaScript 交互:学习进程中的新跨越(一)
javascript·html·交互
Source.Liu1 天前
【学Rust写CAD】19 颜色渐变定义(gradient_stop.rs)
rust·cad
豆芽8192 天前
基于Web的交互式智能成绩管理系统设计
前端·python·信息可视化·数据分析·交互·web·数据可视化
Source.Liu2 天前
【学Rust写CAD】15 定点数实现(fixed.rs)
rust·cad
Hello.Reader2 天前
基于 WebAssembly 的 Game of Life 交互实现
交互·wasm
Source.Liu2 天前
【学Rust写CAD】18 定点数2D仿射变换矩阵结构体(MatrixFixedPoint结构别名)
矩阵·rust·cad
Julian.zhou2 天前
从Manus到OpenManus:AI智能体技术如何重塑未来生活场景?
人工智能·自然语言处理·生活·交互
承前智2 天前
基于Hbuilder X的uni-app连接OneNET云平台及AI交互 实战指南(二)——获取数据流模型的数据
uni-app·交互