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.
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
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'~
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'~
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.
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'~
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'~
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.
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'~
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.
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.
Please, explain a bit more
Do you want to select the objects inside the circles, ellipses, splines?
~'J'~
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.
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'~
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.
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
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'~
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.
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
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'~
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.