.NET

.NET

Reply
Active Contributor
bkenyon13
Posts: 45
Registered: ‎04-20-2012
Message 1 of 35 (889 Views)
Accepted Solution

Insert Block on Multiple Selected Points

889 Views, 34 Replies
04-20-2012 06:56 AM

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.

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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 35 (864 Views)

Re: Insert Block on Multiple Selected Points

04-21-2012 12:00 PM 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
*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 3 of 35 (860 Views)

Re: Insert Block on Multiple Selected Points

04-21-2012 01:46 PM 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
Active Contributor
bkenyon13
Posts: 45
Registered: ‎04-20-2012
Message 4 of 35 (839 Views)

Re: Insert Block on Multiple Selected Points

04-23-2012 06:38 AM 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.

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 5 of 35 (829 Views)

Re: Insert Block on Multiple Selected Points

04-23-2012 09:24 AM 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
*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 6 of 35 (824 Views)

Re: Insert Block on Multiple Selected Points

04-23-2012 11:33 AM 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
Active Contributor
bkenyon13
Posts: 45
Registered: ‎04-20-2012
Message 7 of 35 (812 Views)

Re: Insert Block on Multiple Selected Points

04-24-2012 06:18 AM 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.

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 8 of 35 (807 Views)

Re: Insert Block on Multiple Selected Points

04-24-2012 07:08 AM 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
Active Contributor
bkenyon13
Posts: 45
Registered: ‎04-20-2012
Message 9 of 35 (784 Views)

Re: Insert Block on Multiple Selected Points

04-26-2012 07:13 AM 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.

Active Contributor
bkenyon13
Posts: 45
Registered: ‎04-20-2012
Message 10 of 35 (781 Views)

Re: Insert Block on Multiple Selected Points

04-26-2012 07:31 AM 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.

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.