[原创].NET开发ARX程序（2）与COM的交互操作

zfbj

目前用.NET开发ARX应用程序是局限性还是比较大的，因为在根据以前的ObjectARX创建新的ARX托管封装类时，缩减了不少ARX中有用的函数，最明显的就是在托管封装中居然没有提供提示用户输入的函数，例如GetPoint、GetString等函数。所幸，我们可以在封装托管中继续使用以前的VBA，也就是说通过COM方式使用ActiveX技术来弥补部分的不足。下面的程序将要介绍在托管封装中使用ActiveX中提供的获取用户输入方法：（1）在Visual Studio.NET中，创建一个新的“类库”项目，选择【项目／添加引用】菜单项，系统会弹出【添加引用】对话框。在【.NET】选项卡中，添加对AutoCAD 2005安装根目录下的acdbmgd.dll和acmgd.dll两个文件的引用；在【COM】选项卡中，引用AutoCAD 2005对象类型库和AutoCAD/ObjectDBX Common 16.0类型库。前者在每个托管封装程序中均要引用，后者则是为了使用COM而引用。（2）在新建的类中，添加下面的代码：

2. Imports Autodesk.AutoCAD.ApplicationServicesImports Autodesk.AutoCAD.DatabaseServicesImports Autodesk.AutoCAD.RuntimeImports System.Runtime.InteropServicesImports Autodesk.AutoCAD.Interop               ' 需要添加AutoCAD 2005和DBX R16类型库才可以引用Imports Autodesk.AutoCAD.Geometry  Public Class TestARX       <CommandMethod("ZffTest", "UseCom", CommandFlags.Modal)> _       Public Shared Sub UseCom()               Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)               Dim acadDoc As AcadDocument                 ' 提示用户输入两个点                 Dim ptStart, ptEnd As Object               ptStart = acadApp.ActiveDocument.Utility.GetPoint(, "指定起点：")               ptEnd = acadApp.ActiveDocument.Utility.GetPoint(ptStart, Chr(13) & Chr(10) & "指定终点：")                 ' 使用COM技术创建的直线               Dim objLine As Common.AcadLine               objLine = acadApp.ActiveDocument.ModelSpace.AddLine(ptStart, ptEnd)                 ' 使用ARX创建的直线               Dim startPt As New Point3d()               Dim endPt As New Point3d()                 startPt.Set(ptStart(0), ptStart(1), ptStart(2))               endPt.Set(ptEnd(0), ptEnd(1), ptEnd(2))                 Dim line As Line               Dim bt As BlockTable               Dim btr As BlockTableRecord                 Try                       Dim db As Database = HostApplicationServices.WorkingDatabase                       Dim objId As ObjectId = db.BlockTableId                       ' 打开块表，注意：ObjectId.Open()取代了以前的acdbOpenObject函数                       bt = objId.Open(OpenMode.ForRead)                       objId = bt.Item(btr.ModelSpace)                       btr = objId.Open(OpenMode.ForWrite)                       ' 创建直线                       line = New Line(startPt, endPt)                       ' 将直线添加到块表记录中                       btr.AppendEntity(line)               Catch                       ' 这里不需要捕获错误               Finally         ' 无论是否产生错误，Finally的语句都将被调用                       ' 这里没有处理事务，因此手工关闭实体                       line.Close()                       btr.Close()                       bt.Close()               End Try         End SubEnd Class

Imports Autodesk.AutoCAD.ApplicationServicesImports Autodesk.AutoCAD.DatabaseServicesImports Autodesk.AutoCAD.RuntimeImports System.Runtime.InteropServicesImports Autodesk.AutoCAD.Interop               ' 需要添加AutoCAD 2005和DBX R16类型库才可以引用Imports Autodesk.AutoCAD.Geometry  Public Class TestARX       <CommandMethod("ZffTest", "UseCom", CommandFlags.Modal)> _       Public Shared Sub UseCom()               Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)               Dim acadDoc As AcadDocument                 ' 提示用户输入两个点                 Dim ptStart, ptEnd As Object               ptStart = acadApp.ActiveDocument.Utility.GetPoint(, "指定起点：")               ptEnd = acadApp.ActiveDocument.Utility.GetPoint(ptStart, Chr(13) & Chr(10) & "指定终点：")                 ' 使用COM技术创建的直线               Dim objLine As Common.AcadLine               objLine = acadApp.ActiveDocument.ModelSpace.AddLine(ptStart, ptEnd)                 ' 使用ARX创建的直线               Dim startPt As New Point3d()               Dim endPt As New Point3d()                 startPt.Set(ptStart(0), ptStart(1), ptStart(2))               endPt.Set(ptEnd(0), ptEnd(1), ptEnd(2))                 Dim line As Line               Dim bt As BlockTable               Dim btr As BlockTableRecord                 Try                       Dim db As Database = HostApplicationServices.WorkingDatabase                       Dim objId As ObjectId = db.BlockTableId                       ' 打开块表，注意：ObjectId.Open()取代了以前的acdbOpenObject函数                       bt = objId.Open(OpenMode.ForRead)                       objId = bt.Item(btr.ModelSpace)                       btr = objId.Open(OpenMode.ForWrite)                       ' 创建直线                       line = New Line(startPt, endPt)                       ' 将直线添加到块表记录中                       btr.AppendEntity(line)               Catch                       ' 这里不需要捕获错误               Finally         ' 无论是否产生错误，Finally的语句都将被调用                       ' 这里没有处理事务，因此手工关闭实体                       line.Close()                       btr.Close()                       bt.Close()               End Try         End SubEnd Class

需要注意下面的几个问题。获得ActiveX中AcadApplication的语句是：

2. Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)

Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)

提示用户输入一点的语句与VBA中略有不同，就是ptStart被声明为Object类型，具体代码是：

2. Dim ptStart, ptEnd As ObjectptStart = acadApp.ActiveDocument.Utility.GetPoint(, "指定起点：")

Dim ptStart, ptEnd As ObjectptStart = acadApp.ActiveDocument.Utility.GetPoint(, "指定起点：")

使用ActiveX创建直线时，省略了以前的Set关键字，这也是VB.NET的语法改变，具体代码：

2. Dim objLine As Common.AcadLineobjLine = acadApp.ActiveDocument.ModelSpace.AddLine(ptStart, ptEnd)

Dim objLine As Common.AcadLineobjLine = acadApp.ActiveDocument.ModelSpace.AddLine(ptStart, ptEnd)

将用户输入的结果使用到ARX中，这是我们最关心的一个问题，实际上只要使用Point3d类的Set方法即可。如果要保证程序的严密，可以对ptStart的类型进行判断。具体的代码是：

2. Dim startPt As New Point3d()Dim endPt As New Point3d()  startPt.Set(ptStart(0), ptStart(1), ptStart(2))endPt.Set(ptEnd(0), ptEnd(1), ptEnd(2))

Dim startPt As New Point3d()Dim endPt As New Point3d()  startPt.Set(ptStart(0), ptStart(1), ptStart(2))endPt.Set(ptEnd(0), ptEnd(1), ptEnd(2))

上面的程序仅说明了简单地使用ActiveX的方法，但是获得AcadApplication对象之后，所有重要的ActiveX方法都可以在ARX中使用了。

雪山飞狐_lzh

有一点始终不太明白，用GetEntity获得的ActiveX对象如何转化为Arx实体

ntchjie

不知道我为什么还提示未定义类型，我已经引用了。

ntchjie

Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)


在第一个AcadApplication上，是不是我用cad2006的原因？

netarx

请问，如何只用arx不用activex就能让自定义的excel插件访问acad

gwevergree

这样就可以提示用户输入点坐标了。

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.GraphicsInterface
Imports DBTransMan = Autodesk.AutoCAD.DatabaseServices.TransactionManager

Public Class Class1

 <CommandMethod("MyLine")> Public Function Myline()
        Dim db As Database = HostApplicationServices.WorkingDatabase()
        Dim myT As Transaction = db.TransactionManager.StartTransaction()
        Dim x1, y1, z1, x2, y2, z2 As Single
        Try
            Dim prPointOptions As PromptPointOptions = New PromptPointOptions("指定起点:")
            Dim prPointRes As PromptPointResult
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            prPointRes = ed.GetPoint(prPointOptions)
            If prPointRes.Status <> PromptStatus.OK Then
                ed.WriteMessage("你选择的点无效,请重新选择！")
            Else
                ed.WriteMessage("起点: " & prPointRes.Value.ToString())
                x1 = prPointRes.Value.X
                y1 = prPointRes.Value.Y
                z1 = prPointRes.Value.Z
            End If
            Dim prPointOptions1 As PromptPointOptions = New PromptPointOptions("指定终点:")
            prPointRes = ed.GetPoint(prPointOptions1)
            If prPointRes.Status <> PromptStatus.OK Then
                ed.WriteMessage("你选择的点无效,请重新选择！")
            Else
                ed.WriteMessage("终点: " & prPointRes.Value.ToString())
                x2 = prPointRes.Value.X
                y2 = prPointRes.Value.Y
                z2 = prPointRes.Value.Z
            End If
            Dim line As Line = New Line(New Point3d(x1, y1, z1), New Point3d(x2, y2, z2))
            Dim bt As BlockTable = CType(myT.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
            Dim btr As BlockTableRecord = CType(myT.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)
            btr.AppendEntity(line)
            myT.AddNewlyCreatedDBObject(line, True)
            myT.Commit()
        Catch
        Finally
            myT.Dispose()
        End Try
    End Function

End Class

quren

Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)

在第一个AcadApplication上，是不是我用cad2006的原因？

我的也有此问题！提示说：“AcadApplication”不是“System.Windows.Forms.Application”的成员。

 

dry

楼主太厉害了，谢谢楼主

yyi

我的是VS2005+Autocad2007，但是引用AutoCAD 2007对象类型库和AutoCAD/ObjectDBX Common 17.0类型库不成功啊。楼主帮忙。

见图：

lilianhulctu

顶