参考文献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。
参考文献