Try this code instead, see how to use two selection sets
with the same coordinates, i've added some handlers
to check if appropriate entities selected, probably you
may want to remove them from code
Code:
<CommandMethod("insblk")> _
Public Sub TestForInsert()
'Selects the dwg file to be used as the block that is inserted
Dim ofd As New OpenFileDialog(title:="Block Selection", defaultName:="", dialogName:="Block Selection", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
ofd.ShowDialog()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim points As IDictionary(Of Point3d, Integer) = New Dictionary(Of Point3d, Integer)
'Specifies the selection area
Dim ppo As New PromptPointOptions(vbLf & "First Corner:")
Dim ppr As PromptPointResult = ed.GetPoint(ppo)
Dim pco As New PromptCornerOptions(vbLf & "Second Corner:", ppr.Value)
Dim pcr As PromptPointResult = ed.GetCorner(pco)
'Gets the start and end points of the selected polylines
Dim p1 As Point3d = ppr.Value
Dim p2 As Point3d = pcr.Value
Dim pts As New Point3dCollection()
pts.Add(p1)
pts.Add(New Point3d(p2.X, p1.Y, 0))
pts.Add(p2)
pts.Add(New Point3d(p1.X, p2.Y, 0))
'Creates a selection filter
Dim tv As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LWPOLYLINE,POINT")}
Dim flt As New SelectionFilter(tv)
Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
If res.Status <> PromptStatus.OK Then Return
Dim tv1 As TypedValue() = New TypedValue() {New TypedValue(DxfCode.Start, "LINE")}
Dim flt1 As New SelectionFilter(tv1)
Dim res1 As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt1)
If res1.Status <> PromptStatus.OK Then Return
Using doclock As DocumentLock = doc.LockDocument
Using tr As Transaction = db.TransactionManager.StartTransaction()
Try
'Creates the specified block within the dwg
Dim bt As BlockTable
bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim blkid As ObjectId
Dim ndb As Database = New Database(False, True)
ndb.ReadDwgFile(ofd.Filename, FileOpenMode.OpenForReadAndReadShare, True, Nothing)
Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.Filename)
Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
blkid = db.Insert(name, ndb, True)
For Each selobj As SelectedObject In res.Value
Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
'Gets the selected polylines
Dim pline As Polyline
pline = TryCast(ent, Polyline)
'Gets the selected points
Dim pt As DBPoint
pt = TryCast(ent, DBPoint)
If pline IsNot Nothing Then
'Runs the shared function to get the coordinates of the polylines
Dim vertices As Point3dCollection = New Point3dCollection()
For i As Integer = 0 To pline.NumberOfVertices - 1
vertices.Add(pline.GetPoint3dAt(i))
'Adds the block to the polylines
Dim br As BlockReference = New BlockReference(vertices(i), blkid)
br.SetDatabaseDefaults()
btr.AppendEntity(br)
tr.AddNewlyCreatedDBObject(br, True)
Next
Else
If pt IsNot Nothing Then
Dim verts As Point3d = pt.Position
'Adds the block to the points
Dim br2 As BlockReference = New BlockReference(verts, blkid)
br2.SetDatabaseDefaults()
btr.AppendEntity(br2)
tr.AddNewlyCreatedDBObject(br2, True)
End If
End If
Next
For Each selobj As SelectedObject In res1.Value
Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
'Gets the selected lines
Dim ln As Line
ln = TryCast(ent, Line)
If ln IsNot Nothing Then
Dim i As Integer = 1
Dim ps As Point3d = ln.StartPoint
Dim pe As Point3d = ln.EndPoint
Try
points.Add(New KeyValuePair(Of Point3d, Integer)(ps, i))
i += 1
points.Add(New KeyValuePair(Of Point3d, Integer)(pe, i))
i += 1
Catch
End Try
Dim inspts As Point3dCollection = New Point3dCollection
For Each kvp As KeyValuePair(Of Point3d, Integer) In points
inspts.Add(kvp.Key)
Next kvp
'Adds the block to the lines
For Each pt As Point3d In inspts
Dim br3 As BlockReference = New BlockReference(pt, blkid)
br3.SetDatabaseDefaults()
btr.AppendEntity(br3)
tr.AddNewlyCreatedDBObject(br3, True)
Next
End If
Next
'Commits to the changes made
tr.Commit()
Catch ex As System.Exception
ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
End Try
End Using
End Using
End Sub Let me know if this code is working for ou
~'J'~
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
