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
