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

server/2024/10/15 22:24:27/

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


http://www.ppmy.cn/server/46035.html

相关文章

任务悬赏系统:遵守规则,轻松赚取佣金

前言 在数字化时代&#xff0c;任务悬赏系统作为一种新兴的平台&#xff0c;正逐渐融入我们的日常生活。这类系统不仅为用户提供了自我展示和技能变现的舞台&#xff0c;更成为了一种轻松赚取佣金的途径。 一、任务悬赏系统是什么&#xff1f; 简单来说&#xff0c;任务悬赏系…

MySQL -- SQL笔试题相关

1.银行代缴花费bank_bill 字段名描述serno流水号date交易日期accno账号name姓名amount金额brno缴费网点 serno: 一个 BIGINT UNSIGNED 类型的列&#xff0c;作为主键&#xff0c;且不为空。该列是自动增量的&#xff0c;每次插入新行时&#xff0c;都会自动递增生成一个唯一的…

优化CPU占用率及内存占用2

在标准化无线通信板时&#xff0c;关注过程序占用ram的问题&#xff0c;当时 发现每一个线程都会分配8M栈空间&#xff0c;这次换rk3568后&#xff0c;偶尔看了下RAM占用&#xff0c;吓了一跳&#xff0c;不但每个线程有8M栈空间&#xff0c;几乎每个线程都占用了64MB的一个RAM…

使用PNP管控制MCU是否需要复位

这两台用到一款芯片带电池&#xff0c;希望电池还有电芯片在工作的时候插入电源不要给芯片复位&#xff0c;当电池没电&#xff0c;芯片不在工作的时候&#xff0c;插入电源给芯片复位所以使用一个PNP三极管&#xff0c;通过芯片IO控制是否打开复位&#xff0c;当芯片正常工作的…

git生成密钥(免密)

生成SSH密钥对的方法如下&#xff1a; 打开Git Bash。 输入以下命令生成新的SSH密钥对&#xff1a; ssh-keygen -t rsa -b 4096 -C "your_emailexample.com" 这里的 -C 参数后面跟的是你的邮箱地址&#xff0c;通常用于标识这个密钥。 当系统提示你“Enter a fil…

用Spherical Demon做 spherical alignment预处理

主要用到的是&#xff1a; SD_rotateAtlas2Sphere.m function [curr_sbjWarp, Center1, Center2, Center3, prev_energy, curr_energy] SD_rotateAtlas2Sphere(sbjMesh, basic_atlas, parms, SearchWidth, numIntervals)函数SD_rotateAtlas2Sphere的5个输入参数和返回6个输出…

请描述Vue常用的修饰符

在 Vue 中&#xff0c;修饰符&#xff08;Modifiers&#xff09;常用于自定义指令&#xff08;Directives&#xff09;和事件监听&#xff08;Event Listeners&#xff09;中&#xff0c;以改变指令或事件监听器的默认行为。以下是一些 Vue 中常用的修饰符&#xff1a; 1. 事件…

layui实现鼠标移入/移出时显示/隐藏tips

layui实现鼠标移入/移出时显示/隐藏tips弹窗 注&#xff1a;其它弹窗亦可按照此方法实现相同效果 鼠标移入 dom 或 tips 区域&#xff0c;显示 tips 弹窗&#xff1b; 鼠标移出 dom 或 tips 区域&#xff0c;隐藏 tips 窗口&#xff1b; <div id"box">鼠标移入…