Break LWPolyLine at Point

Hi!

I would like to break a polyline in a given dot. All necessary data known to the operation, I cannot make it with VBA.

If VBA is not capable to do the operation, then it is possible to make it with Sendcommand? (even running with LISP code from VBA?)

For example:

My polyline:

Me.Hide

ThisDrawing.Activate

ThisDrawing.Utility.GetEntity objent, varPick, vbCr & "Pick a polyline: "

Me.Show

The braking point:

X=1000 Y=500 Z=0

Try to break (not working):

Dim xkoord as Double

Dim ykoord as Double

xkoord = 1000

ykoord = 500

Set vonallánc = objent.Copy()

ThisDrawing.SendCommand "_BREAK" & vbCr

Dim kiv As AcadSelectionSet

On Error Resume Next

Set kiv = ThisDrawing.SelectionSets("SSET")

kiv.Delete

Set kiv = ThisDrawing.SelectionSets.Add("SSET")

kiv.AddItems vonallánc '

kiv.Select vonallánc [/i]'

ThisDrawing.SendCommand "F" & vbCr 'Choose Break at First Point

ThisDrawing.SendCommand Replace(xkoord, ",", ".") & "," & Replace(ykoord, ",", ".") & vbCr

ThisDrawing.SendCommand Replace(xkoord, ",", ".") & "," & Replace(ykoord, ",", ".") & vbCr

kiv.Select acSelectionSetPrevious

'kiv.Erase

Set vlánc = kiv.Item(0)

MsgBox vlánc.Length[/i]

Can somebody help to fix this code? Thank you!

Hy

I solve the problem, but with for..next is not working (through acSelectionSetPrevious). This code is good to breaking a selected polyline onetime.

Public Sub MegTör(ByVal objektum As AcadLWPolyline, ByVal Xkoordináta As Double, ByVal Ykoordináta As Double)
   Dim s As AcadSelectionSet
   Dim h As AcadEntity
   
   ThisDrawing.SendCommand Chr(28)
   ThisDrawing.SendCommand Chr(28)
   ThisDrawing.SendCommand "_BREAK" & vbCr
   
   On Error Resume Next
   ThisDrawing.SelectionSets("TempSSet").Delete
   Set s = ThisDrawing.SelectionSets.Add("TempSSet")
   
   Set h = objektum.Copy
   s.AddItems h
   h.Highlight True
   
   ThisDrawing.SelectionSets.Item("TempSSet").Select acSelectionSetPrevious
       
   ThisDrawing.SendCommand Replace(Xkoordináta, ",", ".") & "," & Replace(Ykoordináta, ",", ".") & ",0" & vbCr
   ThisDrawing.SendCommand Replace(Xkoordináta, ",", ".") & "," & Replace(Ykoordináta, ",", ".") & ",0" & vbCr
           
   h.Highlight False
   s.Erase
   s.Delete

   Application.Update
End Sub

Hey guys, slightly off topic, but you may like to read this thread

Hey guys, slightly off topic, but you may like to read this thread

Sorry, I am new here yet.

Sorry, I am new here yet.

Not a problem, just a heads-up