189 8069 5689
如果可以的话请把分给我
让客户满意是我们工作的目标，不断超越客户的期望值来自于我们对这个行业的热爱。我们立志把好的技术通过有效、简单的方式提供给客户，将通过不懈努力成为客户在信息化领域值得信任、有价值的长期合作伙伴，公司提供的服务项目有：国际域名空间、网站空间、营销软件、网站建设、岑溪网站维护、网站推广。
以下是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
vb2010(vb.net）貌似已经没有OLE控件
下面的代码是用PictureBox控件显示CAD的DWG文件
Private Structure BITMAPFILEHEADER
Dim bfType As Short
Dim bfSize As Integer
Dim bfReserved1 As Short
Dim bfReserved2 As Short
Dim bfOffBits As Integer
End Structure
Public Function GetDwgImage(ByVal FileName As String) As Image
If Not File.Exists(FileName) Then Exit Function
Dim DwgF As FileStream '文件流
Dim PosSentinel As Integer '文件描述块的位置
Dim br As BinaryReader '读取二进制文件
Dim TypePreview As Integer '缩略图格式
Dim PosBMP As Integer '缩略图位置
Dim LenBMP As Integer '缩略图大小
Dim biBitCount As Short '缩略图比特深度
Dim biH As BITMAPFILEHEADER 'BMP文件头，DWG文件中不包含位图文件头，要自行加上去
Dim BMPInfo() As Byte '包含在DWG文件中的BMP文件体
Dim BMPF As New MemoryStream '保存位图的内存文件流
Dim bmpr As New BinaryWriter(BMPF) '写二进制文件类
Dim myImg As Image
Try
DwgF = New FileStream(FileName, FileMode.Open, FileAccess.Read) '文件流
br = New BinaryReader(DwgF)
DwgF.Seek(13, SeekOrigin.Begin) '从第十三字节开始读取
PosSentinel = br.ReadInt32 '第13到17字节指示缩略图描述块的位置
DwgF.Seek(PosSentinel + 30, SeekOrigin.Begin) '将指针移到缩略图描述块的第31字节
TypePreview = br.ReadByte '第31字节为缩略图格式信息，2 为BMP格式，3为WMF格式
Select Case TypePreview
Case 1
Case 2, 3
PosBMP = br.ReadInt32 'DWG文件保存的位图所在位置
LenBMP = br.ReadInt32 '位图的大小
DwgF.Seek(PosBMP + 14, SeekOrigin.Begin) '移动指针到位图块
biBitCount = br.ReadInt16 '读取比特深度
DwgF.Seek(PosBMP, SeekOrigin.Begin) '从位图块开始处读取全部位图内容备用
BMPInfo = br.ReadBytes(LenBMP) '不包含文件头的位图信息
br.Close()
DwgF.Close()
With biH '建立位图文件头
.bfType = H4D42
If biBitCount 9 Then .bfSize = 54 + 4 * (2 ^ biBitCount) + LenBMP Else .bfSize = 54 + LenBMP
.bfReserved1 = 0 '保留字节
.bfReserved2 = 0 '保留字节
.bfOffBits = 14 + H28 + 1024 '图像数据偏移
End With
'以下开始写入位图文件头
bmpr.Write(biH.bfType) '文件类型
bmpr.Write(biH.bfSize) '文件大小
bmpr.Write(biH.bfReserved1) '0
bmpr.Write(biH.bfReserved2) '0
bmpr.Write(biH.bfOffBits) '图像数据偏移
bmpr.Write(BMPInfo) '写入位图
BMPF.Seek(0, SeekOrigin.Begin) '指针移到文件开始处
myImg = Image.FromStream(BMPF) '创建位图文件对象
Return myImg
bmpr.Close()
BMPF.Close()
End Select
Catch ex As Exception
Return Nothing
End Try
End Function
你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 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 '界面可视
你去查查书吧，书上挺详细的，在这说不好说，你先在项目里引用。然后 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 '界面可视
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
这个是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