VB.net进行CAD二次开发(三)

参考文献1中CAD .net开发系列1-7,非常地好,需要逐一测试和运行

'上面的catch块只显示一个错误信息。实际的清理工作是在finally块中进行的。这样做的理由是如果在事务处理被提交(Commit())之前,Dispose()被调用的话,

'事务处理会被 销毁。我们认为如果在trans.Commit()之前出现任何错误的话,你应该销毁事务处理(因为Commit将永远不会被调用)。

'如果在Dispose()之前调用了Commit(),也就是说没有任何错误发生,那么事务处理将会被提交给数据库。

'所以基于上面的分析,Catch块其实并不是必须的,因为它只用来通知用户程序出现了一个错误。它将在下面的代码中被去掉。

创建实体到某个图层

<CommandMethod("CreateEmployee")>

Public Sub CreateEmployee()

Dim db As Database = HostApplicationServices.WorkingDatabase

Dim trans As Transaction = db.TransactionManager.StartTransaction()

Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

Dim objID As ObjectId

Try

Dim circle As Circle = New Circle(New Point3d(10, 10, 0), Vector3d.ZAxis, 2)

'' Open the Block table for read

Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)

'' Open the Block table record Model space for write

Dim btr As BlockTableRecord = DirectCast(trans.GetObject(HostApplicationServices.WorkingDatabase.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

objID = CreateLayer()

circle.LayerId = objID

btr.AppendEntity(circle)

trans.AddNewlyCreatedDBObject(circle, True)

'增加多行文本

Using acMText As MText = New MText()

acMText.Location = New Point3d(2, 2, 0)

acMText.Width = 4

acMText.Contents = "This is a text string for the MText object."

acMText.LayerId = objID

btr.AppendEntity(acMText)

trans.AddNewlyCreatedDBObject(acMText, True)

End Using

Using ellipse As Ellipse = New Ellipse()

ellipse.Set( _

New Point3d(0, 0, 0), _

New Vector3d(0, 0, 1), _

New Vector3d(100, 0, 0), _

0.6, _

0, _

Math.PI * 2)

ellipse.LayerId = objID

btr.AppendEntity(ellipse)

trans.AddNewlyCreatedDBObject(ellipse, True)

End Using

trans.Commit()

Catch ex As Exception

ed.WriteMessage("Error ")

Finally

trans.Dispose()

End Try

End Sub

Public Function CreateLayer() As ObjectId

Dim layerId As ObjectId '它返回函数的值

Dim db As Database = HostApplicationServices.WorkingDatabase

Dim trans As Transaction = db.TransactionManager.StartTransaction()

Try

'首先取得层表......

Dim lt As LayerTable = DirectCast(trans.GetObject(db.LayerTableId, OpenMode.ForWrite), LayerTable)

'检查EmployeeLayer层是否存在......

If lt.Has("EmployeeLayer") Then

layerId = lt("EmployeeLayer")

Else

'如果EmployeeLayer层不存在,就创建它

Dim ltr As LayerTableRecord = New LayerTableRecord()

ltr.Name = "EmployeeLayer" '设置层的名字

ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, 2)

layerId = lt.Add(ltr)

trans.AddNewlyCreatedDBObject(ltr, True)

End If

trans.Commit()

Finally

trans.Dispose()

End Try

Return layerId

End Function

'创建块,并将块添加到模型空间

<CommandMethod("CreateEmployeeBlock")>

Public Sub CreateEmployeeBlock()

Dim db As Database = HostApplicationServices.WorkingDatabase

Dim trans As Transaction = db.TransactionManager.StartTransaction()

Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

Dim objID As ObjectId

Try

Dim circle As Circle = New Circle(New Point3d(10, 10, 0), Vector3d.ZAxis, 2)

'' Open the Block table for read

'Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)

'' Open the Block table record Model space for write

objID = CreateEmployeeDefintion()

Dim btr As BlockTableRecord = DirectCast(trans.GetObject(objID, OpenMode.ForWrite), BlockTableRecord)

btr.AppendEntity(circle)

trans.AddNewlyCreatedDBObject(circle, True)

'增加多行文本

Using acMText As MText = New MText()

acMText.Location = New Point3d(2, 2, 0)

acMText.Width = 4

acMText.Contents = "This is a text string for the MText object."

btr.AppendEntity(acMText)

trans.AddNewlyCreatedDBObject(acMText, True)

End Using

Using ellipse As Ellipse = New Ellipse()

ellipse.Set( _

New Point3d(0, 0, 0), _

New Vector3d(0, 0, 1), _

New Vector3d(100, 0, 0), _

0.6, _

0, _

Math.PI * 2)

btr.AppendEntity(ellipse)

trans.AddNewlyCreatedDBObject(ellipse, True)

End Using

' Insert the block into the current space

If objID <> ObjectId.Null Then

'建立块的参考

Using acBlkRef As New BlockReference(New Point3d(0, 0, 0), objID)

'空间

Dim acCurSpaceBlkTblRec As BlockTableRecord

acCurSpaceBlkTblRec = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

acCurSpaceBlkTblRec.AppendEntity(acBlkRef)

trans.AddNewlyCreatedDBObject(acBlkRef, True)

End Using

End If

trans.Commit()

Catch ex As Exception

ed.WriteMessage("Error ")

Finally

trans.Dispose()

End Try

End Sub

'有块返回ID,无块,新建,返回ID

Public Function CreateEmployeeDefintion() As ObjectId

Dim blockId As ObjectId = ObjectId.Null '它返回函数的值

Dim db As Database = HostApplicationServices.WorkingDatabase

Dim trans As Transaction = db.TransactionManager.StartTransaction()

Try

'首先取得块表......

Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)

'检查EmployeeBlock块是否存在......

If bt.Has("EmployeeBlock") Then

blockId = bt("EmployeeBlock")

Else

'如果EmployeeBlock块不存在,就创建它

Dim newBtr As BlockTableRecord = New BlockTableRecord()

newBtr.Name = "EmployeeBlock"

newBtr.Origin = New Point3d(0, 0, 0)

trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

bt.Add(newBtr)

trans.AddNewlyCreatedDBObject(newBtr, True)

blockId = newBtr.Id

End If

trans.Commit()

Finally

trans.Dispose()

End Try

Return blockId

End Function

<CommandMethod("CreatePalette1")>

Public Sub CreatePalette1()

ps = New PaletteSet("Test Palette Set")

ps.MinimumSize = New System.Drawing.Size(300, 300)

ps.Style = PaletteSetStyles.ShowTabForSingle

ps.Opacity = 90

Dim myCtrl As System.Windows.Forms.UserControl = New ModelessForm()

ps.Add("test", myCtrl)

ps.Visible = True

End Sub

启动dll的方法:

1.自动启动AutoCAD:

选择工程根目录(解决方案下面的),鼠标右键-->属性-->

工程属性对话框-->调试标签-->启动操作:启动外部程序-->浏览选择AutoCAD的安装目录,选择acad.exe。

2.手动加载类库:

(1) 按F5;

(2) 自动启动AutoCAD,一路继续。

(3) 在CAD命令行手动输入"netload",浏览到自己的动态连接库文件。

3.自动加载类库:

(1) 工程属性对话框-->调试标签-->启动选项-->命令行参数中输入:

/nologo /b "..\..\start.scr"

让CAD自动在命令执行工程目录里的start.scr文件。

(2) 然后就是在工程目录的根目录创建一个文本文件,名字取为"start.scr",并在此文件中输入如下文本:

netload "..\..\bin\debug\lubanren_2008.dll"

(3) 按F5。

参考文献

https://www.cnblogs.com/jdmei520/ca
tegory/137967.html

相关推荐
专注VB编程开发20年7 小时前
C#.NET模拟用户点击按钮button1.PerformClick自动化测试
开发语言·自动化测试·c#·vb.net
专注VB编程开发20年3 天前
写.NET可以指定运行SUB MAIN吗?调用任意一个里面的类时,如何先执行某段初始化代码?
开发语言·vb.net
专注VB编程开发20年4 天前
WebView2最低支持.NET frame4.5,win7系统
c#·.net·webview2·vb.net
专注VB编程开发20年4 天前
C#,VB.NET正则表达式法替换代码
正则表达式·c#·.net·vb.net
专注VB编程开发20年11 天前
Aspose.words,Aspose.cells,vb.net,c#加载许可证,生成操作选择:嵌入的资源
c#·word·.net·vb.net
rrokoko3 个月前
TIOBE 指数 12 月排行榜公布,VB.Net排行第九
编程语言·vb.net
一只小灿灿4 个月前
VB.NET 从入门到精通:开启编程进阶之路
.net·vb.net
中游鱼5 个月前
微软官方 .NET 混淆软件 Dotfuscator
microsoft·c#·.net·混淆·vb.net·dotfuscator
中游鱼6 个月前
目前最新 Reflector V11.1.0.2067版本 .NET 反编译软件
c#·.net·vb.net·.net reflector·反编译.net·最新版本
rrokoko7 个月前
TIOBE 编程指数 9 月排行榜公布 VB.Net第七
.net·vb.net