社区 › AutoCAD.net/VB.net/C# 编程技术 › 将DWG文件作为块插入当前图形的VB代码

tcsl9621 发表于 2006-9-7 21:34:00

将DWG文件作为块插入当前图形的VB代码

请问哪位老大知道？还烦请相告。

tcsl9621 发表于 2006-9-8 19:46:00

<P>明经的.NET开发版块做的不好。没有人气。越来越……</P>

tcsl9621 发表于 2006-9-10 20:53:00

<P>Public Function InsertBlock(ByVal sourceFileName As String, ByVal newBlockName As String, ByVal po As Point3d) As ObjectId<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'Dim sourceFileName As String = "E:\FreeNEST2\FreeNEST2\bin\Project\My test project\Part\Part1.dwg"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'Dim newBlockName As String = "Part1"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim db As Database = HostApplicationServices.WorkingDatabase()<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim trans As Transaction = db.TransactionManager.StartTransaction()<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim btr As BlockTableRecord = trans.GetObject(bt(btr.ModelSpace), OpenMode.ForWrite)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Try<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sourceDatabase As Database = GetDatabaseFromFile(sourceFileName)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '把源数据库模型空间中的实体插入到当前数据库的一个新的块表记录中<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim bobj As ObjectId = HostApplicationServices.WorkingDatabase.Insert(newBlockName, sourceDatabase, False)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim bref As BlockReference = New BlockReference(po, bobj)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blockobj As ObjectId = btr.AppendEntity(bref)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ''''<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim empBtr As BlockTableRecord = trans.GetObject(bt(newBlockName), OpenMode.ForRead)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim id As ObjectId<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each id In empBtr<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim ent As Entity = trans.GetObject(id, OpenMode.ForRead, False)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If TypeOf ent Is AttributeDefinition Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim attRef As AttributeReference = New AttributeReference<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.SetPropertiesFrom(attDef)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.Position = New Point3d(bref.Position.X + attDef.Position.X, bref.Position.Y + attDef.Position.Y, bref.Position.Z + attDef.Position.Z)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.Height = attDef.Height<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.Rotation = attDef.Rotation<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.Tag = attDef.Tag<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; attRef.TextString = attDef.TextString<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bref.AttributeCollection.AppendAttribute(attRef)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; trans.AddNewlyCreatedDBObject(attRef, True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '''<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; trans.AddNewlyCreatedDBObject(bref, True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Return blockobj<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Catch e As System.Exception<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Application.ShowAlertDialog(e.Message)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Try<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '''<BR>&nbsp;&nbsp;&nbsp; End Function</P>
<P>&nbsp;&nbsp;&nbsp; Private Function GetDatabaseFromFile(ByVal fileName As String) As Database<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '''<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim databaseFromFile As Database = New Database(False, True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; databaseFromFile.ReadDwgFile(fileName, System.IO.FileShare.Read, False, DBNull.Value.ToString)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '为了让插入块的函数在多个图形文件打开的情况下起作用，你必须使用下面的函数把源数据库对象关闭。<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; databaseFromFile.CloseInput(True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Return databaseFromFile<BR>&nbsp;&nbsp;&nbsp; End Function</P>
<P>&nbsp;</P>
<P>源程序，有才鸟老大的也有我自已的东西。希望对大家有用。</P>

houlinbo 发表于 2006-12-30 15:44:00

<p>不行&nbsp; ，复制过去不能用&nbsp;&nbsp; </p><p>另外再请教 ，我会VBA，要再学VB.net 二次开发需从头开始吗？</p>

tcsl9621 发表于 2007-1-1 11:41:00

会VBA会有些帮助，但不是完全相同。

houlinbo 发表于 2007-1-11 14:57:00

<p>关闭时出现致命错误，为什么？QQ420021327</p>

waley111 发表于 2007-1-17 20:47:00

<p>我是在VB中用的</p><p>先将需要插入的dwg当作外部参照插入，然后再绑定为块</p><p>可能这不是最好的办法，但是当时没办法，想了好久才解决的一个办法。</p><p></p><p>''''''''插入图</p><p>&nbsp;&nbsp;&nbsp; Dim insertedBlock As Object&nbsp; 'AcadExternalReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp; Pt_Temp_1(0) = 0<br/>&nbsp;&nbsp;&nbsp; Pt_Temp_1(1) = 0<br/>&nbsp;&nbsp;&nbsp; Pt_Temp_1(2) = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; TXT_STR = App.Path &amp; "\twz.dwg"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set insertedBlock = AcadDoc.ModelSpace.AttachExternalReference(TXT_STR, "TWZ", Pt_Temp_1, 1, 1, 1, 0, False)<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; AcadDoc.Blocks.Item(insertedBlock.Name).Bind False<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; </p>

查看完整版本: 将DWG文件作为块插入当前图形的VB代码