Imports System
Imports System.Text
Imports System.IO
Imports System.Data
Imports System.Linq
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.LayerManager
Imports Autodesk.AutoCAD.Windows
' This line is not mandatory, but improves loading performances
<Assembly: CommandClass(GetType(TransferAttributes.MyCommands))>
Namespace TransferAttributes
' This class is instantiated by AutoCAD for each document when
' a command is called by the user the first time in the context
' of a given document. In other words, non static data in this class
' is implicitly per-document!
Public Class MyCommands
<CommandMethod("UpdateAtts")> _
Public Sub UpdateAtts()
Dim myDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim myEd As Editor = myDoc.Editor
Dim selEntID As ObjectId = myEd.GetEntity("Select Old Block:").ObjectId
Dim selEntID2 As ObjectId '= myEd.GetEntity("Select New block:").ObjectId
Dim myXML As New Xml.XmlDocument()
myXML.Load("c:\i-cad\UpdateAtts_A.xml")
Using myTrans As Transaction = myDoc.Database.TransactionManager.StartTransaction
Dim myBrefA As BlockReference = selEntID.GetObject(OpenMode.ForWrite)
Dim myBrefB As BlockReference '= selEntID2.GetObject(OpenMode.ForWrite)
Dim myAttsA As AttributeCollection = myBrefA.AttributeCollection
Dim myAttsB As AttributeCollection '= myBrefB.AttributeCollection
Dim blockNameA As String = ""
Dim blockNameB As String = ""
If myBrefA.Name.StartsWith("*") Then
Dim myBTR As BlockTableRecord = myBrefA.DynamicBlockTableRecord.GetObject(OpenMode.ForRead)
blockNameA = myBTR.Name
Else
blockNameA = myBrefA.Name
End If
Dim oldNode As Xml.XmlNode = myXML.SelectSingleNode("//oldblock[@name='" & blockNameA.ToUpper & "']")
Dim myBT As BlockTable = myDoc.Database.BlockTableId.GetObject(OpenMode.ForWrite)
If myBT.Has(oldNode.Attributes("newname").Value) = False Then
'insert DWG file as a Block
Dim myDWG As New IO.FileInfo(oldNode.Attributes("path").Value)
If myDWG.Exists = False Then
MsgBox("The file " & myDWG
.FullName & " does not exist.") Exit Sub
End If
'Create a blank Database
Dim dwgDB As New Database(False, True)
'Read a DWG file into the blank database
dwgDB.ReadDwgFile(myDWG.FullName, FileOpenMode.OpenForReadAndAllShare, True, "")
'insert the dwg file into the current file's block table
myDoc.Database.Insert(oldNode.Attributes("newname").Value.ToUpper, dwgDB, True)
'close/dispose of the previously blank database.
dwgDB.Dispose()
End If
selEntID2 = InsertBlock(myDoc.Database, myBrefA.BlockName, myBrefA.Position, oldNode.Attributes("newname").Value, myBrefA.ScaleFactors.X, myBrefA.ScaleFactors.Y, myBrefA.ScaleFactors.Z)
myBrefB = selEntID2.GetObject(OpenMode.ForWrite)
myAttsB = myBrefB.AttributeCollection
For Each myNode As Xml.XmlNode In oldNode.SelectNodes("attribute")
For Each myAttID As ObjectId In myAttsA
Dim myAtt As AttributeReference = myAttID.GetObject(OpenMode.ForRead)
If myAtt.Tag.ToUpper = myNode.Attributes("name").Value.ToUpper Then
For Each myAttBID As ObjectId In myAttsB
Dim myAttB As AttributeReference = myAttBID.GetObject(OpenMode.ForWrite)
If myAttB.Tag.ToUpper = myNode.Attributes("newname").Value.ToUpper Then
myAttB.TextString = myAtt.TextString
End If
Next
End If
Next
Next
myBrefA.Erase()
myTrans.Commit()
End Using
End Sub
Public Function InsertBlock(ByVal DatabaseIn As Database, _
ByVal BTRToAddTo As String, _
ByVal InsPt As Geometry.Point3d, _
ByVal BlockName As String, _
ByVal XScale As Double, _
ByVal YScale As Double, _
ByVal ZScale As Double) As DatabaseServices.ObjectId
Using myTrans As Transaction = DatabaseIn.TransactionManager.StartTransaction
Dim myBlockTable As BlockTable = DatabaseIn.BlockTableId.GetObject(OpenMode.ForRead)
'If the suppplied Block Name is not
'in the specified Database, get out gracefully.
If myBlockTable.Has(BlockName) = False Then
Return Nothing
End If
'If the specified BlockTableRecord does not exist,
'get out gracefully
If myBlockTable.Has(BTRToAddTo) = False Then
Return Nothing
End If
Dim myBlockDef As BlockTableRecord = _
myBlockTable(BlockName).GetObject(OpenMode.ForRead)
Dim myBlockTableRecord As BlockTableRecord = _
myBlockTable(BTRToAddTo).GetObject(OpenMode.ForWrite)
'Create a new BlockReference
Dim myBlockRef As New BlockReference(InsPt, myBlockDef.Id)
'Set the scale factors
myBlockRef.ScaleFactors = New Geometry.Scale3d(XScale, YScale, ZScale)
'Add the new BlockReference to the specified BlockTableRecord
myBlockTableRecord.AppendEntity(myBlockRef)
'Add the BlockReference to the BlockTableRecord.
myTrans.AddNewlyCreatedDBObject(myBlockRef, True)
Dim myAttColl As DatabaseServices.AttributeCollection = _
myBlockRef.AttributeCollection
'Find Attributes and add them to the AttributeCollection
'of the BlockReference
For Each myEntID As ObjectId In myBlockDef
Dim myEnt As Entity = myEntID.GetObject(OpenMode.ForRead)
If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then
Dim myAttDef As DatabaseServices.AttributeDefinition = myEnt
Dim myAttRef As New DatabaseServices.AttributeReference
myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
myAttColl.AppendAttribute(myAttRef)
myTrans.AddNewlyCreatedDBObject(myAttRef, True)
End If
Next
myTrans.Commit()
Return myBlockRef.Id
End Using
End Function
