重庆分公司,新征程启航
为企业提供网站建设、域名注册、服务器等服务
Dim ppr As PromptPointResult = ed.GetPoint("请选择插入点:")
乌海海南ssl适用于网站、小程序/APP、API接口等需要进行数据传输应用场景,ssl证书未来市场广阔!成为成都创新互联的ssl证书销售渠道,可以享受市场价格4-6折优惠!如果有意向欢迎电话联系或者加微信:18982081108(备注:SSL证书合作)期待与您的合作!
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
Private Sub Command1_Click()
'首先引用 acad 2009 Object Library类型库
Dim myAcadApp As AutoCAD.AcadApplication, activeDoc As AutoCAD.AcadDocument, acMS As AutoCAD.AcadModelSpace
On Error Resume Next
Set myAcadApp = GetObject(, "Autocad.Application") '检查AutoCAD是否已经打开
If Err 0 Then '没有打开
Err.Clear
Set myAcadApp = CreateObject("Autocad.Application") '打开CAD
If Err Then
MsgBox Err.Number ":" Err.Description '打开失败
Exit Sub
End If
End If
On Error GoTo prcERR
myAcadApp.Visible = True '显示CAD
Set activeDoc = myAcadApp.ActiveDocument
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
Dim LineObj As AcadLine'如果画图时出错,改为Dim LineObj As Object
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
Set LineObj = activeDoc.ModelSpace.AddLine(startPoint, endPoint) '画线
prcExit:
Set activeDoc = Nothing
Set myAcadApp = Nothing
Exit Sub
prcERR:
MsgBox Err.Number ":" Err.Description, vbCritical, "错误"
Resume prcExit
End Sub
VB可以与CAD连接,但要先转化为文本文档,在编写一个接口程序。
不过,实际上一般不会这样做,因为在CAD当中可以直接加载VB,就是我们通常说的VBA,一般用作CAD的二次开发来用,比如说自动绘图。语法和VB差不多,只是一些细小的差别,很简单的。
打开CAD,点击“工具”/“宏”/VB管理器,再在里面写程序,运行时,要先加载VB,再点击“宏”里面的“加载工程”,再把你的程序加载进去就可以运行了。如果你的程序不能运行,说明你是用VB编写的,不是用VBA编写的,虽然语法相同,但也运行不了,你自己试试吧!其实只要你会VB,VBA就很简单,只是一般用来画图要计算坐标,很麻烦!
你去查查书吧,书上挺详细的,在这说不好说,你先在项目里引用。然后 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 '界面可视