如果可以的話請把分給我
讓客戶滿意是我們工作的目標,不斷超越客戶的期望值來自于我們對這個行業(yè)的熱愛。我們立志把好的技術通過有效、簡單的方式提供給客戶,將通過不懈努力成為客戶在信息化領域值得信任、有價值的長期合作伙伴,公司提供的服務項目有:國際域名空間、網(wǎng)站空間、營銷軟件、網(wǎng)站建設、岑溪網(wǎng)站維護、網(wǎng)站推廣。
以下是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)貌似已經(jīng)沒有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??'保存位圖的內(nèi)存文件流
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)?'從第十三字節(jié)開始讀取
PosSentinel?=?br.ReadInt32?'第13到17字節(jié)指示縮略圖描述塊的位置
DwgF.Seek(PosSentinel?+?30,?SeekOrigin.Begin)?'將指針移到縮略圖描述塊的第31字節(jié)
TypePreview?=?br.ReadByte?'第31字節(jié)為縮略圖格式信息,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)?'從位圖塊開始處讀取全部位圖內(nèi)容備用
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?'保留字節(jié)
.bfReserved2?=?0?'保留字節(jié)
.bfOffBits?=?14?+?H28?+?1024?'圖像數(shù)據(jù)偏移
End?With
'以下開始寫入位圖文件頭
bmpr.Write(biH.bfType)?'文件類型
bmpr.Write(biH.bfSize)?'文件大小
bmpr.Write(biH.bfReserved1)?'0
bmpr.Write(biH.bfReserved2)?'0
bmpr.Write(biH.bfOffBits)?'圖像數(shù)據(jù)偏移
bmpr.Write(BMPInfo)?'寫入位圖
BMPF.Seek(0,?SeekOrigin.Begin)?'指針移到文件開始處
myImg?=?Image.FromStream(BMPF)?'創(chuàng)建位圖文件對象
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