Okay, for my next question I need to call a .NET LispFunction I borrowed from here:
http://www.theswamp.org/index.php?topic=42890.0
(specifically the code posted by ChillMe1):
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
I have modified this using an example posted by Tony Tanzillo so that it is now a LispFunction that accepts a lisp selecionset:
'<CommandMethod("UpdateAtts")> _
<LispFunction("UpdateAtts")> _
Public Sub UpdateAtts(args As ResultBuffer)
If args Is Nothing Then
Throw New ArgumentException("Requires one argument")
End If
Dim values As TypedValue() = args.AsArray
If values.Length <> 1 Then
Throw New ArgumentException("Wrong number of arguments")
End If
If values(0).TypeCode <> CInt(LispDataType.SelectionSet) Then
Throw New ArgumentException("Bad argument type - requires a selection set")
End If
Dim ss As SelectionSet = DirectCast(values(0).Value, SelectionSet)
Dim myDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim myEd As Editor = myDoc.Editor
Dim selEntIDs As ObjectId() = ss.GetObjectIds()
Dim selEntID As ObjectId = selEntIDs(0)
'Dim selEntID As ObjectId = myEd.GetEntity("Select Old Block:").ObjectId
'Everything after this point is unchanged from the above - ergo no point in duplicating the code twice in the same post! My Lisp routine that *should* call this .net lispfunction is:
(defun c:uatts (/ss)
(command "netload" C:\Users\Alex\documents\visual studio 2012\Projects\BlockReplace\BlockReplace\bin\Debug\BlockReplace.dll )
(setq ss (ssget "_X" (list (cons 0 "INSERT")'(66.1))))
(updateatts ss)
(princ)
)
but all I see at the command line when I run it is:
; error: too few arguments
Any ideas what I'm missing?
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
