vb.netcad,vbnetcad图块文字

如何用vb.net编程在cad图形中插入dwg图块？

Dim ppr As PromptPointResult = ed.GetPoint("请选择插入点：")

Dim pt As Point3d = ppr.Value

utility.WriteToEditor(pt.ToString())

Dim pidBlock As New PIDBlock()

'自己定义的图块类，保存图块的路径和名称 

pidBlock.Name = "sample"

pidBlock.Path = blockPath  "b_sample.dwg"

Using blkDb As New Database(False, True)

'read drawing 

blkDb.ReadDwgFile(pidBlock.Path, System.IO.FileShare.Read, True, Nothing)

blkDb.CloseInput(True)

Using docLock As DocumentLock = doc.LockDocument()

'多文档要先这样，否则报至命错误 

Using t As Transaction = doc.TransactionManager.StartTransaction()

'insert it as a new block 

Dim idBTR As ObjectId = doc.Database.Insert(pidBlock.Name, blkDb, False)

'create a ref to the block 

Dim bt As BlockTable = DirectCast(t.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)

Dim btr As BlockTableRecord = DirectCast(t.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)

Using bref As New BlockReference(pt, idBTR)

btr.AppendEntity(bref)

t.AddNewlyCreatedDBObject(bref, True)

End Using

t.Commit()

End Using

End Using

End Using

相关问答

Q1: 如何使用vb.net调用cad进行绘图

你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 Dim acadapp As AcadApplication Dim acaddoc As AcadDocument On Error Resume Next AcadApp = GetObject(, "AutoCAD.Application") If Err.Number Then Err.Clear() AcadApp = CreateObject("AutoCAD.Application") If Err.Number Then MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD") Exit Sub End If End If AcadApp.Visible = True '界面可视

Q2: VB.NET连接AutoCAD出错

这个是vb.net教材里面的吧，我也是前两天刚下的。遇到类似的问题，下面是我的解决办法

首先要参考引用Autodesk.AutoCAD.Interop.dll还有Autodesk.AutoCAD.Interop.Common.dll

然后代码有两处也需要相应修改，我用的是.NET 的 vb2008

'Dim AcadApp As AutoCAD.AcadApplication

Dim AcadApp As Autodesk.AutoCAD.Interop.AcadApplication

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Call 连接AutoCAD()

End Sub

Sub 连接AutoCAD()

On Error Resume Next

AcadApp = GetObject(, "AutoCAD.Application")

If Err.Number Then

Err.Clear()

AcadApp = CreateObject("AutoCAD.Application")

If Err.Number Then

MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD")

Exit Sub

End If

End If

AcadApp.Visible = True '界面可视

'AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化

AcadApp.WindowState = Autodesk.AutoCAD.Interop.Common.AcWindowState.acMax

AppActivate(AcadApp.Caption) '显示AutoCAD界面

End Sub

Q3: vb.netcadgetpoint如何只能选切点

利用CAD对象捕捉功能。通过查询netcadgetpoint官网得知，vbnetcadgetpoint可以利用CAD对象捕捉功能才能选切点，vbnetcadgetpoint在新基建工程对话框当选择工程部类为Visual Basic工程。

Q4: VB.Net读取AutoCAD图纸

如果可以的话请把分给我

以下是cad2007版的，引用autocad 2007 type library 和autocad/objectdbx common 17如果是04或者版本更低的只要引用autocad 2007 type library，代码的话大同小异，思路是一样的

 

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        On Error Resume Next

        Dim acadapp As Autodesk.AutoCAD.Interop.AcadApplication

acadapp = GetObject(vbNullString, "autoCAD.application")

        Dim acaddoc As Autodesk.AutoCAD.Interop.AcadDocument

        acaddoc = acadapp.ActiveDocument

        Dim Ms As Autodesk.AutoCAD.Interop.Common.AcadModelSpace

        Ms = acaddoc.ModelSpace

        Dim acadObjectI As Autodesk.AutoCAD.Interop.Common.AcadObject

        Dim Linei As Autodesk.AutoCAD.Interop.Common.AcadLine

        Dim Circlei As Autodesk.AutoCAD.Interop.Common.AcadCircle

        Dim Polylinei As Autodesk.AutoCAD.Interop.Common.AcadPolyline

        Dim pt As Autodesk.AutoCAD.Interop.Common.AcadPoint

For Each acadObjectI In Ms

            Debug.Print(acadObjectI.ObjectName)

            Select Case acadObjectI.ObjectName

                Case "AcDbLine"

                    Linei = acadObjectI

                    Debug.Print("X =" Linei.StartPoint(0).ToString)

                    Debug.Print("Y =" Linei.StartPoint(1).ToString)

                Case ""

                Case ""

End Select

Next

    End Sub

Q5: vb.net打开cad画图的问题？

你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 Dim acadapp As AcadApplication Dim acaddoc As AcadDocument On Error Resume Next AcadApp = GetObject(, "AutoCAD.Application") If Err.Number Then Err.Clear() AcadApp = CreateObject("AutoCAD.Application") If Err.Number Then MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD") Exit Sub End If End If AcadApp.Visible = True '界面可视