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

相关推荐
中游鱼22 天前
微软官方 .NET 混淆软件 Dotfuscator
microsoft·c#·.net·混淆·vb.net·dotfuscator
中游鱼1 个月前
目前最新 Reflector V11.1.0.2067版本 .NET 反编译软件
c#·.net·vb.net·.net reflector·反编译.net·最新版本
rrokoko2 个月前
TIOBE 编程指数 9 月排行榜公布 VB.Net第七
.net·vb.net
VB.Net2 个月前
EmguCV学习笔记 VB.Net 11.9 姿势识别 OpenPose
opencv·计算机视觉·c#·图像·vb.net·emgucv·姿势识别
VB.Net2 个月前
EmguCV学习笔记 VB.Net 12.1 二维码解析
opencv·计算机视觉·c#·图像·vb.net·二维码·emgucv
VB.Net2 个月前
EmguCV学习笔记 VB.Net 12.3 OCR
opencv·计算机视觉·c#·ocr·图像·vb.net·emgucv
VB.Net2 个月前
EmguCV学习笔记 C# 12.3 OCR
opencv·计算机视觉·c#·ocr·vb.net·emgucv
VB.Net2 个月前
EmguCV学习笔记 VB.Net 11.6 图像分割
opencv·计算机视觉·c#·图像分割·dnn·vb.net·emgucv
VB.Net2 个月前
EmguCV学习笔记 VB.Net 11.4 图像分类
opencv·计算机视觉·c#·dnn·图像·vb.net·emgucv
VB.Net2 个月前
EmguCV学习笔记 C# 11.2 DNN推理流程
opencv·计算机视觉·c#·dnn·图像·vb.net·emgucv