189 8069 5689
Dim ppr As PromptPointResult = ed.GetPoint("请选择插入点：")
成都创新互联10余年专注成都高端网站建设定制网站开发服务,为客户提供专业的成都网站制作,成都网页设计,成都网站设计服务;成都创新互联服务内容包含成都网站建设,成都微信小程序,软件开发,网络营销推广,网络运营服务及企业形象设计;成都创新互联拥有众多专业的高端网站制作开发团队,资深的高端网页设计团队及经验丰富的架构师高端网站策划团队;我们始终坚持从客户的角度出发,为客户量身订造网络营销方案，解决网络营销疑问。
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
你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 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 '界面可视
这个是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
利用CAD对象捕捉功能。通过查询netcadgetpoint官网得知，vbnetcadgetpoint可以利用CAD对象捕捉功能才能选切点，vbnetcadgetpoint在新基建工程对话框当选择工程部类为Visual Basic工程。
如果可以的话请把分给我
以下是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
你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 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 '界面可视