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