.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Insert Block on Multiple Selected Points

34 REPLIES 34
SOLVED
Reply
Message 1 of 35
bkenyon13
2417 Views, 34 Replies

Insert Block on Multiple Selected Points

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.

34 REPLIES 34
Message 2 of 35
Hallex
in reply to: bkenyon13

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 3 of 35
Hallex
in reply to: Hallex

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 4 of 35
bkenyon13
in reply to: bkenyon13

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.

Message 5 of 35
Hallex
in reply to: bkenyon13

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 6 of 35
Hallex
in reply to: Hallex

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 7 of 35
bkenyon13
in reply to: bkenyon13

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.

Message 8 of 35
Hallex
in reply to: bkenyon13

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'~

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 9 of 35
bkenyon13
in reply to: bkenyon13

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.

Message 10 of 35
bkenyon13
in reply to: bkenyon13

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.

Message 11 of 35
Hallex
in reply to: bkenyon13

Please, explain a bit more

Do you want to select the objects inside the circles, ellipses, splines?

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 12 of 35
bkenyon13
in reply to: Hallex

Sorry if it is hard to follow I have trouble explaining things easily.

 

Basically I would like to be able to do is place blocks at the end points of polylines and lines as well as on nodes on point entities.

 

I don't want to be restricted to only polylines.

Message 13 of 35
Hallex
in reply to: bkenyon13

You can retrieve startpoint and endpoint of entities easily in this case,

sorry, i can't help right now, coz i'm a bit busy yet

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 14 of 35
bkenyon13
in reply to: Hallex

I understand and thank you for all your help to this point Hallex.

 

I have worked on some code to try and get it to also select the start and end points of a line and also select point entities, but it is not working right and I am not sure that I have the code correct.

 

I have attach a txt file with all my code it it, if anyone can look at it and let me know what I am doing wrong.

 

if someone could easily point out what I have wrong and tell me what it is I should be able to get it fixed, but I am a little lost at this point.

 

Thanks to all you can assist.

Message 15 of 35
bkenyon13
in reply to: bkenyon13

ok, I have got the code workign for polylines as well as lines.

I am still working on the point entities part of it.

I have split the code into two seperate commands one for polylines and the other for lines, for some reason the way I was trying to have them in the same command was not working.

 

however I have ran into a small problem with the one for lines and that if you have two lines connected it will add two blocks to that location as it is both a start point and end point of a line.

 

would I add an if statement in the shared function for the line or the sub for the line to fix that problem?

the other thing is how would I tell it to only insert one block at the location?

 

below is all my code that I have so far and help will be

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows

Public Class Class1
    'Gets the coordinates for the selected polylines
    Public Shared Function GetPolylineCoordinates(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
    'Specifies the command that is used for polylines
    <CommandMethod("plblk")> _
    Public Sub PolylineBlocks()
        '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
        '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(0, "LWPOLYLINE")}
        Dim flt As New SelectionFilter(tv)
        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
        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)
                        If pline IsNot Nothing Then
                            'Runs the shared function to get the coordinates of the polylines
                            Dim vertices As Point3dCollection = GetPolylineCoordinates(pline)
                            For i As Integer = 0 To vertices.Count - 1
                                '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
                        End If
                    Next
                    'Commits to the changes made
                    tr.Commit()
                Catch ex As Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                End Try
            End Using
        End Using
    End Sub
    'Get the Coordinates for the selected lines
    Public Shared Function GetLineCoordinates(ByVal ent3 As Line) As Point3dCollection
        Dim pts3 As Point3dCollection = New Point3dCollection()
        Dim spt As Point3d
        Dim ept As Point3d
        spt = ent3.StartPoint
        ept = ent3.EndPoint
        pts3.Add(spt)
        pts3.Add(ept)
        Return pts3
    End Function
    'Specifies the command that is used for lines
    <CommandMethod("lnblk")> _
    Public Sub LineBlocks()
        '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
        '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(0, "LINE")}
        Dim flt As New SelectionFilter(tv)
        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
        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 lines
                        Dim ln As Line
                        ln = TryCast(ent, Line)
                        If ln IsNot Nothing Then
                            'Run the shared function to get the coordinates of the lines
                            Dim vts As Point3dCollection = GetLineCoordinates(ln)
                            For i As Integer = 0 To vts.Count - 1
                                'Adds the block to the lines
                                Dim br3 As BlockReference = New BlockReference(vts(i), blkid)
                                br3.SetDatabaseDefaults()
                                btr.AppendEntity(br3)
                                tr.AddNewlyCreatedDBObject(br3, True)
                            Next
                        End If
                    Next
                    'Commits to the changes made
                    tr.Commit()
                Catch ex As Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                End Try
            End Using
        End Using
    End Sub
End Class

 

greatly appreciated

Message 16 of 35
Hallex
in reply to: bkenyon13

Your subroutines is completely wrong, so I've removed them from code

See my poor explanation inside the code:

       Public Shared Function GetPolylineCoordinates(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
 
        'Specifies the command that is used
        <CommandMethod("instblk")> _
        Public Sub InsertBlocks()
            '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
            '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
            '' this line is wrong, because of value types is with 0 code (or the same DxfCode.Start)
            ''Dim tv As TypedValue() = New TypedValue() {New TypedValue(0, "LWPOLYLINE"), New TypedValue(1, "POINT"), New TypedValue(1, "LINE")}
            '' this right:
            Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LWPOLYLINE,LINE,POINT")}
            ''OR:
            ' Dim tv As TypedValue() = New TypedValue() {New TypedValue(0, "LWPOLYLINE"), New TypedValue(0, "POINT"), New TypedValue(0, "LINE")}
            Dim flt As New SelectionFilter(tv)
            Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
            MsgBox(res.Value.Count)
            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 lines
                            Dim pt As DBPoint
                            pt = TryCast(ent, DBPoint) '<-- point entity is type of DBPoint in .NET
                            Dim ln As Line
                            ln = TryCast(ent, Line)
                            If pline IsNot Nothing Then
                                'Runs the shared function to get the coordinates of the polylines
                                Dim vertices As Point3dCollection = GetPolylineCoordinates(pline)
                                For i As Integer = 0 To vertices.Count - 1
                                    '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)
                                Else
                                    If ln IsNot Nothing Then
                                        Dim vts As Point3dCollection = New Point3dCollection()
                                        vts.Add(ln.StartPoint)
                                        vts.Add(ln.EndPoint)
                                        'Adds the block to the lines
                                        Dim br3 As BlockReference = New BlockReference(vts(0), blkid)
                                        br3.SetDatabaseDefaults()
                                        btr.AppendEntity(br3)
                                        tr.AddNewlyCreatedDBObject(br3, True)
                                        br3 = New BlockReference(vts(1), blkid)
                                        br3.SetDatabaseDefaults()
                                        btr.AppendEntity(br3)
                                        tr.AddNewlyCreatedDBObject(br3, True)
                                    End If
                                End If
                            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

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 17 of 35
bkenyon13
in reply to: Hallex

Hallex I really do appreciate the time you have spend helping me with this and pretty much giving it to me even though you do not have to it is greatly appreciated.

 

This works perfect, again thank you.

 

the last thing that I have an issue trying to resolve with this is that as mentioned earlier when you have two lines where the end point of one meets the start point of another two blocks are added.  I think this could be resolved with an If statement but I am not sure exactly how to put it in.

 

I am goign to assume it would look something like this:

If ln.startpoint = ln.endpoint then

       (use only ln.startpoint or something) <---- I am not sure on this part of how to only insert one block

End If

 

Possibly even this:

If ln.startpoint.x = ln.endpoint.x and ln.startpon.y = ln.endpoint.y Then

      (Do Something)

End If

 

If you can just let me know if I am going in the right direction or not it would be greatly appreciated.

Message 18 of 35
Hallex
in reply to: bkenyon13

Okay I understand you want to use "chain-selection" for lines

to avoid of inserting the duplicate blocks

In this case you need to write separate Sub for that,

I will be try to show you that later

And also to compare points you may use comapring for all

coordinates with fuzz factor, e.g.:

 

if (math.Abs( p1.X-p2.X)< 0.0001) And _

(math.Abs( p1.Y-p2.Y)< 0.0001) And _

(math.Abs( p1.Z-p2.Z)< 0.0001) then

(do your job here)

else

 

end if

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 19 of 35
Hallex
in reply to: Hallex

Here is simple code to gather line points,

hope you could be able to include it in your project

If not just let me know

        Public Shared Sub TestForLinePoints()
            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))
            Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LINE")}

            Dim flt As New SelectionFilter(tv)
            Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
            Using doclock As DocumentLock = doc.LockDocument
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Try
                        Dim i As Integer = 1
                        For Each selobj As SelectedObject In res.Value
                            Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
                            Dim ln As Line = TryCast(ent, Line)
                            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
                        Next
                        Dim inspts As Point3dCollection = New Point3dCollection
                        For Each kvp As KeyValuePair(Of Point3d, Integer) In points
                            inspts.Add(kvp.Key)
                        Next kvp
                        MsgBox(inspts.Count)
                        tr.Commit()
                    Catch ex As System.Exception
                        ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    End Try
                End Using
            End Using
        End Sub

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 20 of 35
bkenyon13
in reply to: Hallex

Ok, so I look at the code that you gave me and tried a couple different things many of which did not work and some actually crashed AutoCAD.

 

Anyway below is the code that I have so far for the entire project.  I am have issues with the lines still in getting the block to actually insert.

 

I have gotten it to return a message box with values, but not insert a block on the lines.  You will probably say that how I have it was not what you intended, but I do not that it works to a point.

 

Thank you for your assistance

 

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows

Public Class Class1
    'Specifies the command that is used
    <CommandMethod("instblk")> _
    Public Sub InsertBlocks()
        '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,LINE,POINT")}
        Dim flt As New SelectionFilter(tv)
        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
        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)
                        'Gets the selected lines
                        Dim ln As Line
                        ln = TryCast(ent, Line)
                        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)
                            Else
                                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
                                    Dim br3 As BlockReference = New BlockReference(inspts(inspts.Count), blkid)
                                    br3.SetDatabaseDefaults()
                                    btr.AppendEntity(br3)
                                    tr.AddNewlyCreatedDBObject(br3, True)
                                End If
                            End If
                        End If
                    Next
                    'Commits to the changes made
                    tr.Commit()
                Catch ex As Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                End Try
            End Using
        End Using
    End Sub
End Class

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost