Insert Block on Multiple Selected Points

[Anonymous]

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.

[Hallex]

Buddy, you have to create two selectionsets,

one for polylines and points and the second one for lines only,

bot with the same window coordinates

Try again please

~'J'~

[Anonymous]

Sorry as mentioned I am a beginner to programming in .net as well as programming things for autocad.

I do not have any training at all in any programming, I just kind of jump into things, but that is how I learn the best.

ok, for a moment lets forget about the points and polylines as I know that they work.

focusing on the lines could I use the code that use gave for "TestLinesForPoints" can create its own command?

if, so in doing that how would I add the code to add the block to the lines?

The same as before?

for some reason I am missing something probably really easy and stupid.

sorry if you are getting frustrated or anything, again I really appreciate the help.

[Hallex]

Try this code instead, see how to use two selection sets

with the same coordinates, i've added some handlers

to check if appropriate entities selected, probably you

 may want to remove them from code

Code:

        <CommandMethod("insblk")> _
        Public Sub TestForInsert()
            'Selects the dwg file to be used as the block that is inserted
            Dim ofd As New OpenFileDialog(title:="Block Selection", defaultName:="", dialogName:="Block Selection", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
            ofd.ShowDialog()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim points As IDictionary(Of Point3d, Integer) = New Dictionary(Of Point3d, Integer)
            'Specifies the selection area
            Dim ppo As New PromptPointOptions(vbLf & "First Corner:")
            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
            Dim pco As New PromptCornerOptions(vbLf & "Second Corner:", ppr.Value)
            Dim pcr As PromptPointResult = ed.GetCorner(pco)
            'Gets the start and end points of the selected polylines
            Dim p1 As Point3d = ppr.Value
            Dim p2 As Point3d = pcr.Value
            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))
            'Creates a selection filter
            Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LWPOLYLINE,POINT")}
            Dim flt As New SelectionFilter(tv)
            Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
            If res.Status <> PromptStatus.OK Then Return
            Dim tv1 As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LINE")}
            Dim flt1 As New SelectionFilter(tv1)
            Dim res1 As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt1)
            If res1.Status <> PromptStatus.OK Then Return
            Using doclock As DocumentLock = doc.LockDocument
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Try
                        'Creates the specified block within the dwg
                        Dim bt As BlockTable
                        bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
                        Dim blkid As ObjectId
                        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 btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                        blkid = db.Insert(name, ndb, True)
                        For Each selobj As SelectedObject In res.Value
                            Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
                            'Gets the selected polylines
                            Dim pline As Polyline
                            pline = TryCast(ent, Polyline)
                            'Gets the selected points
                            Dim pt As DBPoint
                            pt = TryCast(ent, DBPoint)
                            If pline IsNot Nothing Then
                                'Runs the shared function to get the coordinates of the polylines
                                Dim vertices As Point3dCollection = New Point3dCollection()
                                For i As Integer = 0 To pline.NumberOfVertices - 1
                                    vertices.Add(pline.GetPoint3dAt(i))
                                    'Adds the block to the polylines
                                    Dim br As BlockReference = New BlockReference(vertices(i), blkid)
                                    br.SetDatabaseDefaults()
                                    btr.AppendEntity(br)
                                    tr.AddNewlyCreatedDBObject(br, True)
                                Next
                            Else
                                If pt IsNot Nothing Then
                                    Dim verts As Point3d = pt.Position
                                    'Adds the block to the points
                                    Dim br2 As BlockReference = New BlockReference(verts, blkid)
                                    br2.SetDatabaseDefaults()
                                    btr.AppendEntity(br2)
                                    tr.AddNewlyCreatedDBObject(br2, True)

                                End If
                            End If
                        Next

                        For Each selobj As SelectedObject In res1.Value
                            Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)

                            'Gets the selected lines
                            Dim ln As Line
                            ln = TryCast(ent, Line)

                            If ln IsNot Nothing Then
                                Dim i As Integer = 1
                                Dim ps As Point3d = ln.StartPoint
                                Dim pe As Point3d = ln.EndPoint
                                Try
                                    points.Add(New KeyValuePair(Of Point3d, Integer)(ps, i))
                                    i += 1
                                    points.Add(New KeyValuePair(Of Point3d, Integer)(pe, i))
                                    i += 1
                                Catch
                                End Try
                                Dim inspts As Point3dCollection = New Point3dCollection
                                For Each kvp As KeyValuePair(Of Point3d, Integer) In points
                                    inspts.Add(kvp.Key)
                                Next kvp
                                'Adds the block to the lines

                                For Each pt As Point3d In inspts
                                    Dim br3 As BlockReference = New BlockReference(pt, blkid)
                                    br3.SetDatabaseDefaults()
                                    btr.AppendEntity(br3)
                                    tr.AddNewlyCreatedDBObject(br3, True)
                                Next
                            End If

                        Next
                        'Commits to the changes made
                        tr.Commit()
                    Catch ex As System.Exception
                        ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    End Try
                End Using
            End Using
        End Sub

 Let me know if this code is working for ou

~'J'~

[Anonymous]

I copied all the code over and tried it.

the first time autocad gave a fatal exception not sure why.

I removed the if res.status and if res1.status lines not sure if I should have done that or not

after that I tried again and autocad says this:

Object reference not set to an instance of an object at TestProj.Class1.TestForInsert()

it gives that at line 83 if I select a polyline and line 51 if I select lines

both of those lines are the for each selobj as selectedobject lines

every time this is close to completion it takes two steps backwards

[Anonymous]

ok, I added the if res.status and if res1.status lines back in which resolved the issue with the

two fro each selobj lines

however it does not insert the block on the lines or polylines

its like it does not know where to put the blocks or what block to put there,

[Anonymous]

sorry for the multiple posts, but I just thought I should mention that I am using AutoCAD 2010 if that matters at all.

[Hallex]

I've changed my code see if this working on your end

Code:

        <CommandMethod("insblk")> _
        Public Sub TestForInsert()
            'Selects the dwg file to be used as the block that is inserted
            Dim ofd As New OpenFileDialog(title:="Block Selection", defaultName:="", dialogName:="Block Selection", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
            ofd.ShowDialog()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim points As IDictionary(Of Point3d, Integer) = New Dictionary(Of Point3d, Integer)
            'Specifies the selection area
            Dim ppo As New PromptPointOptions(vbLf & "First Corner:")
            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
            Dim pco As New PromptCornerOptions(vbLf & "Second Corner:", ppr.Value)
            Dim pcr As PromptPointResult = ed.GetCorner(pco)
            'Gets the start and end points of the selected polylines
            Dim p1 As Point3d = ppr.Value
            Dim p2 As Point3d = pcr.Value
            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))
        
            Using doclock As DocumentLock = doc.LockDocument
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Try
                        'Creates the specified block within the dwg
                        Dim bt As BlockTable
                        bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
                        Dim blkid As ObjectId
                        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 btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                        blkid = db.Insert(name, ndb, True)
                        'Creates a selection filter
                        Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LWPOLYLINE,POINT")}
                        Dim flt As New SelectionFilter(tv)
                        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
                        'check if something selected
                        If res.Status = PromptStatus.OK Then
                            'check if selected equal one or more than one item
                            If res.Value.Count > 0 Then
                                For Each selobj As SelectedObject In res.Value
                                    Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
                                    'Gets the selected polylines
                                    Dim pline As Polyline
                                    pline = TryCast(ent, Polyline)
                                    'Gets the selected points
                                    Dim pt As DBPoint
                                    pt = TryCast(ent, DBPoint)
                                    If pline IsNot Nothing Then
                                        'Runs the shared function to get the coordinates of the polylines
                                        Dim vertices As Point3dCollection = New Point3dCollection()
                                        For i As Integer = 0 To pline.NumberOfVertices - 1
                                            vertices.Add(pline.GetPoint3dAt(i))
                                            'Adds the block to the polylines
                                            Dim br As BlockReference = New BlockReference(vertices(i), blkid)
                                            br.SetDatabaseDefaults()
                                            btr.AppendEntity(br)
                                            tr.AddNewlyCreatedDBObject(br, True)
                                        Next
                                    Else
                                        If pt IsNot Nothing Then
                                            Dim verts As Point3d = pt.Position
                                            'Adds the block to the points
                                            Dim br2 As BlockReference = New BlockReference(verts, blkid)
                                            br2.SetDatabaseDefaults()
                                            btr.AppendEntity(br2)
                                            tr.AddNewlyCreatedDBObject(br2, True)

                                        End If
                                    End If
                                Next
                            End If
                        End If

                        Dim tv1 As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LINE")}
                        Dim flt1 As New SelectionFilter(tv1)
                        Dim res1 As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt1)
                        'check if something selected
                        If res1.Status = PromptStatus.OK Then
                            'check if selected equal one or more than one item
                            If res1.Value.Count > 0 Then
                                For Each selobj As SelectedObject In res1.Value
                                    Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)

                                    'Gets the selected lines
                                    Dim ln As Line
                                    ln = TryCast(ent, Line)

                                    If ln IsNot Nothing Then
                                        Dim i As Integer = 1
                                        Dim ps As Point3d = ln.StartPoint
                                        Dim pe As Point3d = ln.EndPoint
                                        Try
                                            points.Add(New KeyValuePair(Of Point3d, Integer)(ps, i))
                                            i += 1
                                            points.Add(New KeyValuePair(Of Point3d, Integer)(pe, i))
                                            i += 1
                                        Catch
                                        End Try
                                        Dim inspts As Point3dCollection = New Point3dCollection
                                        For Each kvp As KeyValuePair(Of Point3d, Integer) In points
                                            inspts.Add(kvp.Key)
                                        Next kvp
                                        'Adds the block to the lines

                                        For Each pt As Point3d In inspts
                                            Dim br3 As BlockReference = New BlockReference(pt, blkid)
                                            br3.SetDatabaseDefaults()
                                            btr.AppendEntity(br3)
                                            tr.AddNewlyCreatedDBObject(br3, True)
                                        Next
                                    End If

                                Next
                            End If
                        End If
                        'Commits to the changes made
                        tr.Commit()
                    Catch ex As System.Exception
                        ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    End Try
                End Using
            End Using
        End Sub

~'J'~

[Anonymous]

ok. tried that and it does work on polylines and lines

however, when doing lines such as 5 lines that are connected

it will put one block at the start point of the first line

two blocks at the endpoint of the first line and the start point of the second line

three blocks at the endpoint of the second line and the startpoint of the third line and so on

so instead of only added an additional block at the start and end point connections of the lines it increases with the number of lines that you have.

is this where the if (math.abs(p1.y-p2.y)<0.0001) And _ comes into play?

or am I completely missing something?

[Hallex]

Let me check this out,

Later

~'J'~

[Anonymous]

ok

on a side note with another project that I am going to be woring on which involves working with sheet sets

I am having issues with being able to bring in the acsmcomponents18lib.tlb file in as a reference.

I am using vb express 2008, I have vb express 2010, but 2008 seems to work better for autocad 2010.

could you possible give me a hint or something of how to add that?

everywhere I look it says to add it as you would a normal reference, but that does not seem to work for me for some reason.

again thanks for all your help.

[Hallex · Accepted solution]

Here is edited code, I've added check if point key is exist in dictionary,

see how it works

from other side I know nothing about using acsmcomponents18lib.tlb,

so you have to start the new thread about,

Code:

        <CommandMethod("insblk")> _
        Public Sub TestForInsert()
            'Selects the dwg file to be used as the block that is inserted
            Dim ofd As New OpenFileDialog(title:="Block Selection", defaultName:="", dialogName:="Block Selection", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
            ofd.ShowDialog()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim points As IDictionary(Of Point3d, Integer) = New Dictionary(Of Point3d, Integer)
            Dim inspts As Point3dCollection = New Point3dCollection
            'Specifies the selection area
            Dim ppo As New PromptPointOptions(vbLf & "First Corner:")
            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
            Dim pco As New PromptCornerOptions(vbLf & "Second Corner:", ppr.Value)
            Dim pcr As PromptPointResult = ed.GetCorner(pco)
            'Gets the start and end points of the selected polylines
            Dim p1 As Point3d = ppr.Value
            Dim p2 As Point3d = pcr.Value
            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))
        
            Using doclock As DocumentLock = doc.LockDocument
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Try
                        'Creates the specified block within the dwg
                        Dim bt As BlockTable
                        bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
                        Dim blkid As ObjectId
                        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 btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                        blkid = db.Insert(name, ndb, True)
                        'Creates a selection filter
                        Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LWPOLYLINE,POINT")}
                        Dim flt As New SelectionFilter(tv)
                        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
                        'check if something selected
                        If res.Status = PromptStatus.OK Then
                            'check if selected equal one or more than one item
                            If res.Value.Count > 0 Then
                                For Each selobj As SelectedObject In res.Value
                                    Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
                                    'Gets the selected polylines
                                    Dim pline As Polyline
                                    pline = TryCast(ent, Polyline)
                                    'Gets the selected points
                                    Dim pt As DBPoint
                                    pt = TryCast(ent, DBPoint)
                                    If pline IsNot Nothing Then
                                        'Runs the shared function to get the coordinates of the polylines
                                        Dim vertices As Point3dCollection = New Point3dCollection()
                                        For i As Integer = 0 To pline.NumberOfVertices - 1
                                            vertices.Add(pline.GetPoint3dAt(i))
                                            'Adds the block to the polylines
                                            Dim br As BlockReference = New BlockReference(vertices(i), blkid)
                                            br.SetDatabaseDefaults()
                                            btr.AppendEntity(br)
                                            tr.AddNewlyCreatedDBObject(br, True)
                                        Next
                                    Else
                                        If pt IsNot Nothing Then
                                            Dim verts As Point3d = pt.Position
                                            'Adds the block to the points
                                            Dim br2 As BlockReference = New BlockReference(verts, blkid)
                                            br2.SetDatabaseDefaults()
                                            btr.AppendEntity(br2)
                                            tr.AddNewlyCreatedDBObject(br2, True)

                                        End If
                                    End If
                                Next
                            End If
                        End If

                        Dim tv1 As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LINE")}
                        Dim flt1 As New SelectionFilter(tv1)
                        Dim res1 As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt1)
                        'check if something selected
                        If res1.Status = PromptStatus.OK Then
                            'check if selected equal one or more than one item
                            If res1.Value.Count > 0 Then
                                For Each selobj As SelectedObject In res1.Value
                                    Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)

                                    'Gets the selected lines
                                    Dim ln As Line
                                    ln = TryCast(ent, Line)

                                    If ln IsNot Nothing Then
                                        Dim i As Integer = 1
                                        Dim ps As Point3d = ln.StartPoint
                                        Dim pe As Point3d = ln.EndPoint
                                        ' check if point exist
                                        If Not points.ContainsKey(ps) Then
                                            points.Add(New KeyValuePair(Of Point3d, Integer)(ps, i))
                                            i += 1
                                        End If
                                        ' check if point exist
                                        If Not points.ContainsKey(pe) Then
                                            points.Add(New KeyValuePair(Of Point3d, Integer)(pe, i))
                                            i += 1
                                        End If
                                      
                                    End If

                                Next

                                ' Add points to the point collection
                                For Each kvp As KeyValuePair(Of Point3d, Integer) In points
                                    inspts.Add(kvp.Key)
                                Next kvp
                                'Adds the block to the lines
                                For Each pt As Point3d In inspts
                                    Dim br3 As BlockReference = New BlockReference(pt, blkid)
                                    br3.SetDatabaseDefaults()
                                    btr.AppendEntity(br3)
                                    tr.AddNewlyCreatedDBObject(br3, True)
                                Next
                            End If
                        End If
                        'Commits to the changes made
                        tr.Commit()
                    Catch ex As System.Exception
                        ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    End Try
                End Using
            End Using
        End Sub

~'J'~

[Anonymous]

This code works perfect, thank you so much.

[Hallex]

Glad I could help

Cheers 🙂

~'J'~

[Anonymous]

one last question if I could.

I copied the compiled dll file to another computer and attemped to run the command and foro some reason it stops and says something about a security issue and to run the ,net configuration tool to resolve the issue.

is there something that I missed in my compiling options or something else?

[Anonymous]

Figured out what the issue was but was not able to resolve it directly.

apparently the issue is that there is a permission problem when trying to run the command that was created when the compiled dll that is loaded is location on a network folder.

I copied the dll file to the local computer and the command worked perfect.