.NET

[#1]

Hello,

I am trying to put something together that will allow a user to select objects in AutoCAD and then place a block at all the selected points. 

Below I have pasted the code that I have so far, but have not been able to test this to see what happens because the Dim ofd part is giving me an error that I have not been able to figure out.  I am only a beginner at this so my code may be wrong and/or ugly.

The error that I am getting says that :

Argument not specified for parameter "flags" of "Public Sub New(title As String, defaultName As String, extension As String, dialogName As String, flags As Autodesk.AutoCAD.Windows.OpenFileDialog.OpenFileDialogFlags)

Code:

Imports Autodesk.AutoCAD.Runtime

Imports Autodesk.AutoCAD.ApplicationServices

Imports Autodesk.AutoCAD.DatabaseServices

Imports Autodesk.AutoCAD.EditorInput

Imports Autodesk.AutoCAD.Geometry

Imports Autodesk.AutoCAD.Windows

PublicClass Class1

    <CommandMethod("pntblk")> _

PublicSub PntBlk()

Dim doc As Document = Application.DocumentManager.MdiActiveDocument

Dim db As Database = doc.Database

Dim ed As Editor = doc.Editor

Using trans As Transaction = db.TransactionManager.StartTransaction()

Dim blktbl As BlockTable

            blktbl = trans.GetObject(db.BlockTableId, _

                                     OpenMode.ForRead)

Dim ofd AsNew OpenFileDialog(dialogName:="Block Selection")

Dim ppo As PromptPointOptions = New PromptPointOptions(SelectionMethod.Crossing)

Dim ppr As PromptPointResult = ed.GetPoint(ppo)

Dim ndb As Database = New Database(False, True)

            ndb.ReadDwgFile(ofd.Filename, FileOpenMode.OpenForReadAndReadShare,True, Nothing)

Dim name AsString = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.Filename)

Dim id As ObjectId = db.Insert(name, ndb, True)

Dim btr As BlockTableRecord = CType(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

Dim inst As BlockReference = New BlockReference(ppr.Value, id)

            btr.AppendEntity(inst)

            inst.SetDatabaseDefaults()

            trans.AddNewlyCreatedDBObject(inst,True)

            trans.Commit()

EndUsing

End Sub

End Class

Any Assistance will be appreciated.

[#2]

Not sure about of your task but maybe this

will help with FileDialog,

Just changea  file name to save the newly created drawing:

        <CommandMethod("pntblk", CommandFlags.Session Or CommandFlags.Modal)> _
        Public Sub PntBlk()

            Dim ofd As New Windows.Forms.OpenFileDialog

            ofd.Title = "Block Selection"

            ofd.Filter = "Drawings (*.dwg)|*.dwg"

            ofd.FilterIndex = 0

            ofd.Multiselect = False

            ofd.InitialDirectory = Environment.CurrentDirectory

            If ofd.ShowDialog <> Windows.Forms.DialogResult.OK Then

                Return
            Else

                MsgBox(ofd.FileName)

            End If

            Dim fname As String = "C:\Test\MYDWG.dwg"

            Dim doc As Document = Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor


            Try

                Using doclock As DocumentLock = doc.LockDocument

                    Dim db As Database = doc.Database

                    Using trans As Transaction = db.TransactionManager.StartTransaction

                        Dim blktbl As BlockTable

                        blktbl = trans.GetObject(db.BlockTableId, OpenMode.ForRead)

                        Dim ppo As PromptPointOptions = New PromptPointOptions("") ''(SelectionMethod.Crossing)

                        ppo.Message = vbLf + "Pick a point: "

                        Dim ppr As PromptPointResult = ed.GetPoint(ppo)

                        Dim ndb As Database = New Database(False, True)

                        ndb.ReadDwgFile(ofd.FileName, FileOpenMode.OpenForReadAndReadShare, True, Nothing)

                        Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.FileName)

                        Dim id As ObjectId = db.Insert(name, ndb, True)

                        Dim btr As BlockTableRecord = CType(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

                        Dim inst As BlockReference = New BlockReference(ppr.Value, id)

                        inst.SetDatabaseDefaults()

                        btr.AppendEntity(inst)

                        trans.AddNewlyCreatedDBObject(inst, True)

                        trans.Commit()

                        db.CloseInput(True)

                        db.SaveAs(fname, False, DwgVersion.Current, db.SecurityParameters)

                    End Using

                End Using

            Catch ex As System.Exception

                ed.WriteMessage(ex.Message)

            End Try

        End Sub

~'J'~

[#3]

Here is updated code

        <CommandMethod("pntblk", CommandFlags.Session Or CommandFlags.Modal)> _
        Public Sub PntBlk()

            Dim ofd As New Windows.Forms.OpenFileDialog

            ofd.Title = "Block Selection"

            ofd.Filter = "Drawings (*.dwg)|*.dwg"

            ofd.FilterIndex = 0

            ofd.Multiselect = False

            ofd.InitialDirectory = Environment.CurrentDirectory

            If ofd.ShowDialog <> Windows.Forms.DialogResult.OK Then

                Return
            Else

                MsgBox(ofd.FileName)

            End If

            Dim fname As String = "C:\Test\MYDWG.dwg"

            Dim doc As Document = Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor


            Try

                Using doclock As DocumentLock = doc.LockDocument

                    Dim db As Database = doc.Database

                    Using trans As Transaction = db.TransactionManager.StartTransaction

                        Dim blktbl As BlockTable

                        blktbl = trans.GetObject(db.BlockTableId, OpenMode.ForRead)

                        Dim ndb As Database = New Database(False, True)

                        ndb.ReadDwgFile(ofd.FileName, FileOpenMode.OpenForReadAndReadShare, True, Nothing)

                        Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.FileName)

                        Dim id As ObjectId = db.Insert(name, ndb, True)

                        Dim btr As BlockTableRecord = CType(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

                        Dim ppo As PromptPointOptions = New PromptPointOptions("")

                        ppo.Message = vbLf + "Pick a first point: "

                        Dim ppr As PromptPointResult = ed.GetPoint(ppo)

                        If ppr.Status <> PromptStatus.OK Then Return

                        Dim inst As BlockReference = New BlockReference(ppr.Value, id)

                        inst.SetDatabaseDefaults()

                        btr.AppendEntity(inst)

                        trans.AddNewlyCreatedDBObject(inst, True)

                        doc.TransactionManager.QueueForGraphicsFlush()

                        ppo.Message = vbLf + "Pick a next point (or press ESC to Exit): "

                        Do While ppr.Status = PromptStatus.OK

                            ppr = ed.GetPoint(ppo)

                            If ppr.Status = PromptStatus.Cancel Then Exit Do

                            inst = New BlockReference(ppr.Value, id)

                            inst.SetDatabaseDefaults()

                            btr.AppendEntity(inst)

                            trans.AddNewlyCreatedDBObject(inst, True)

                            doc.TransactionManager.QueueForGraphicsFlush()
                        Loop

                        doc.TransactionManager.FlushGraphics()
                        ed.UpdateScreen()
                        trans.Commit()
                        ' in case:
                        'db.CloseInput(True)
                        'db.SaveAs(fname, False, DwgVersion.Current, db.SecurityParameters)

                    End Using

                End Using

            Catch ex As System.Exception

                ed.WriteMessage(ex.Message)

            End Try

        End Sub

~'J'~

[#4]

Thank you for the response and the code it is very helpfull.

My goal is to be able to do a selection window and then based on the selection be able to have a block inserted at all the selected points such as at all the end points of all the selected lines.

Like if I had sewer lines that I need to add a manhole symbol to I would be able just to run the command, select the manhol block to use, select the lines I want to add the block too then it would add that block to all the end points of all the lines that I have selected without having to select each location to place it.

I would think it would use the "PromptSelectionOptions" and "PromptSelectionResults", but I have not been able to find a way to have it get the location of the selected entities and insert the block.

Again I am not expecting anyone to write the code, but just point me to the right direction is helpful.  Thank You.

[#5]

Okay, here you go, just use method as I shown before to import your blocks

and also change layer name of water profile pipeline inside the code

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

        Public Shared Function GetPlineCoordinates(ByVal ent As Polyline) As Point3dCollection

            Dim pts As Point3dCollection = New Point3dCollection()
            Dim coord As Point3d
            Dim i As Integer = 0
            For i = 0 To ent.NumberOfVertices - 1
                coord = ent.GetPoint3dAt(i)
                pts.Add(coord)
            Next
            Return pts
        End Function
        <CommandMethod("manholes")> _
        Public Sub InsertManholes()
            Dim blkname As String = "manhole"
            Dim layername As String = "MyLayer"
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim ppo As New PromptPointOptions(vbLf & "First corner point: ")
            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
            If ppr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim pco As New PromptCornerOptions(vbLf & "Other corner: ", ppr.Value)
            Dim pcr As PromptPointResult = ed.GetCorner(pco)
            If pcr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim p1 As Point3d = ppr.Value
            Dim p2 As Point3d = pcr.Value
            If p1.X = p2.X OrElse p1.Y = p2.Y Then
                ed.WriteMessage(vbLf & "Wrong coordinates specified")
                Return
            End If

            Dim pts As New Point3dCollection()
            pts.Add(p1)
            pts.Add(New Point3d(p2.X, p1.Y, 0))
            pts.Add(p2)
            pts.Add(New Point3d(p1.X, p2.Y, 0))

            Dim tv As TypedValue() = New TypedValue() {New TypedValue(0, "LWPOLYLINE"), New TypedValue(8, layername)}

            Dim flt As New SelectionFilter(tv)
            Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)

            If res.Status <> PromptStatus.OK Then Return

            MsgBox(res.Value.Count.ToString)
            Using tr As Transaction = db.TransactionManager.StartTransaction
                Try
                    Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)

                    If Not bt.Has(blkname) Then
                        Return
                    End If

                    Dim blkid As ObjectId = bt(blkname)

                    Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)


                    For Each selObj As SelectedObject In res.Value
                        Dim ent As Entity = tr.GetObject(selObj.ObjectId, OpenMode.ForRead)
                        Dim pline As Polyline
                        pline = TryCast(ent, Polyline)
                        If pline IsNot Nothing Then
                            Dim vertices As Point3dCollection = GetPlineCoordinates(pline)

                            For i As Integer = 0 To vertices.Count - 1

                                Dim inst As BlockReference = New BlockReference(vertices(i), blkid)

                                inst.SetDatabaseDefaults()

                                btr.AppendEntity(inst)

                                tr.AddNewlyCreatedDBObject(inst, True)

                                doc.TransactionManager.QueueForGraphicsFlush()
                            Next

                        End If
                    Next
                    tr.Commit()
                Catch ex As System.Exception

                    ed.WriteMessage(ex.Message)

                End Try
            End Using
        End Sub

~'J'~

[#6]

Here is complete routine if you could not gather them all

                Public Shared Function GetPlineCoordinates(ByVal ent As Polyline) As Point3dCollection

            Dim pts As Point3dCollection = New Point3dCollection()
            Dim coord As Point3d
            Dim i As Integer = 0
            For i = 0 To ent.NumberOfVertices - 1
                coord = ent.GetPoint3dAt(i)
                pts.Add(coord)
            Next
            Return pts
        End Function

        Public Sub ApplyAttributes(db As Database, tr As Transaction, bref As BlockReference)
            Dim btrec As BlockTableRecord = TryCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

            If btrec.HasAttributeDefinitions Then
                Dim atcoll As Autodesk.AutoCAD.DatabaseServices.AttributeCollection = bref.AttributeCollection

                For Each subid As ObjectId In btrec
                    Dim ent As Entity = DirectCast(subid.GetObject(OpenMode.ForRead), Entity)

                    Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition)

                    If attDef IsNot Nothing Then

                        Dim attRef As New AttributeReference()

                        attRef.SetDatabaseDefaults()
                        'optional
                        attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)

                        attRef.Position = attDef.Position.TransformBy(bref.BlockTransform)

                        attRef.Justify = attDef.Justify
                        'must be added all other properties for right position, eg. alignment modes etc
                        attRef.Tag = attDef.Tag

                        attRef.AdjustAlignment(db)

                        atcoll.AppendAttribute(attRef)


                        tr.AddNewlyCreatedDBObject(attRef, True)
                    End If

                Next
            End If
        End Sub
        <CommandMethod("manholes", CommandFlags.Session Or CommandFlags.Modal)> _
        Public Sub InsertManholes()
            Dim blkname As String = "manhole"

            Dim layername As String = "MyLayer"

            Dim ofd As New Windows.Forms.OpenFileDialog

            ofd.Title = "Block Selection"

            ofd.Filter = "Drawings (*.dwg)|*.dwg"

            ofd.FilterIndex = 0

            ofd.Multiselect = False

            ofd.InitialDirectory = Environment.CurrentDirectory

            If ofd.ShowDialog <> Windows.Forms.DialogResult.OK Then

                Return
            Else

                MsgBox(ofd.FileName)

            End If

            Dim doc As Document = Application.DocumentManager.MdiActiveDocument

            Dim db As Database = doc.Database

            Dim ed As Editor = doc.Editor

            Dim ppo As New PromptPointOptions(vbLf & "First corner point: ")

            Dim ppr As PromptPointResult = ed.GetPoint(ppo)

            If ppr.Status <> PromptStatus.OK Then
                Return
            End If

            Dim pco As New PromptCornerOptions(vbLf & "Other corner: ", ppr.Value)

            Dim pcr As PromptPointResult = ed.GetCorner(pco)

            If pcr.Status <> PromptStatus.OK Then
                Return
            End If

            Dim p1 As Point3d = ppr.Value

            Dim p2 As Point3d = pcr.Value

            If p1.X = p2.X OrElse p1.Y = p2.Y Then
                ed.WriteMessage(vbLf & "Wrong coordinates specified")
                Return
            End If

            Dim pts As New Point3dCollection()
            pts.Add(p1)
            pts.Add(New Point3d(p2.X, p1.Y, 0))
            pts.Add(p2)
            pts.Add(New Point3d(p1.X, p2.Y, 0))

            Dim tv As TypedValue() = New TypedValue() {New TypedValue(0, "LWPOLYLINE"), New TypedValue(8, layername)}

            Dim flt As New SelectionFilter(tv)
            Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)

            If res.Status <> PromptStatus.OK Then Return
            Using doclock As DocumentLock = doc.LockDocument

                Using tr As Transaction = db.TransactionManager.StartTransaction

                    Try

                        Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)

                        Dim blkid As ObjectId

                        If Not bt.Has(blkname) Then

                            Dim ndb As Database = New Database(False, True)

                            ndb.ReadDwgFile(ofd.FileName, FileOpenMode.OpenForReadAndReadShare, True, Nothing)

                            Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.FileName)

                            blkid = db.Insert(name, ndb, True)

                        End If

                        blkid = bt(blkname)

                        Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

                        For Each selObj As SelectedObject In res.Value

                            Dim ent As Entity = tr.GetObject(selObj.ObjectId, OpenMode.ForRead)

                            Dim pline As Polyline

                            pline = TryCast(ent, Polyline)

                            If pline IsNot Nothing Then

                                Dim vertices As Point3dCollection = GetPlineCoordinates(pline)

                                For i As Integer = 0 To vertices.Count - 1

                                    Dim inst As BlockReference = New BlockReference(vertices(i), blkid)

                                    inst.SetDatabaseDefaults()

                                    btr.AppendEntity(inst)

                                    tr.AddNewlyCreatedDBObject(inst, True)

                                    ApplyAttributes(db, tr, inst)

                                    doc.TransactionManager.QueueForGraphicsFlush()
                                Next

                            End If
                        Next
                        tr.Commit()

                    Catch ex As System.Exception

                        ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)

                    End Try
                End Using
            End Using
        End Sub

~'J'~

[#7]

Thank you for all your help.

I got your code and tried it, but when I first tried it nothing happened.  it did not insert any blocks and also did not give me any errors.

However I then modified the code for the OFD part to be as follows:

Dim ofd AsNew OpenFileDialog(title:="Block Selection", extension:="dwg", defaultName:="", dialogName:="Block Selection", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)

        ofd.ShowDialog()

I am not sure exactly the difference, but I believe what I changed was for the dialog to open in AutoCAD rather then Windows.

I then ran the command again and get the following error:

eKeyNotFound

at Autodesk.AutoCAD.DatbaseServices.SymbolTable.get_item(String Key)

at PntBlk.Class1.Insertmanholes ()

Not exactly sure what that means, but there is no reference to the symboltable.get_item any where in the code, but maybe needs to be??

Not sure why it would want the SymbolTable and at this time I am not able to examine the code to try and work it out.  All and any assistance is greatly appreciated.

[#8]

I have no ideas about this issue

Try to use "manhole.dwg" where you do the followingt:

create your "block image" as few circles and attribute definitions

but don't to create it as block itself, then save and close

then run my code again

~'J'~

[#9]

I have had some time to look at the code and I have been able to get it to work.

The error was coming from the line of "blkisd= bt (blkname)"

Not exactly sure why, but I removed that and redid a liitle bit of the code and it is not working like a charm.

However there is one more factor that I would like to add and I am not sure where or how.  I would like to have this command work for Lines, Polylines and Point entities in CAD.

would that be easily done by adding some more code to where the "LWPOLYLINE" is or would the entire thing have to be modified to get the coordinates of the different entities.

again if you can just let me know that I am on the right path that will help.

[#10]

Ammendment to the last post.

The code IS working like a charm.

and the line of code that was giving the error was "blkid = bt (blkname)"

sorry for the misspellings and so on.

Again also if I can get this to work for multiple entities other then just polylines then it would be perfect.

Thanks for all your efforts.