MLINE SPLIT in VBA

[frenkas]

Hello,

 

I've made one very useful tool. It's called MLINE SPLIT and you guessed what it does. However it doesn't work on first and second vertices (1 and 2 vertex), and that is real mystery for me. Why are these vertices so different than all the other vertices. Below is my VBA code:

 

Public Sub MLineSplit()

On Error GoTo eh

Dim ent As AcadEntity

Dim p1 As Variant

Dim p2 As Variant

Dim x As Double

Dim y As Double

Dim atst As Double

Dim min_atst As Double

Dim taskas As Double

Dim atst_nustatytas As Boolean

Dim dblVertices() As Double

Dim dblVerticesCnt As Double

Dim dblVertices2() As Double

Dim dblVerticesCnt2 As Double

Dim sset As AcadSelectionSet

Dim perdavimui As Variant

Dim obj As AcadMLine

Dim obj2 As AcadMLine

Dim varpnt As Variant

Dim krd(2) As Double

Dim aa As Integer

Dim objEnt As AcadMLine

Dim objEnt2 As AcadMLine

ThisDrawing.Utility.GetEntity ent, 1, "Select MLINE: "

p2 = ThisDrawing.Utility.GetPoint(, "Select the SPLIT point in MLINE: ")

x = p2(0): y = p2(1)

atst_nustatytas = False

dblVerticesCnt = -1

dblVerticesCnt2 = -1

'randam artimiausia

If TypeOf ent Is AcadMLine Then 'AcadBlockRef isrinkimas

Set obj = ent

'ThisDrawing.SetVariable "CMLSTYLE", obj.StyleName

For aa = 0 To UBound(obj.Coordinates) Step 3

'MsgBox Str(obj.Coordinates(aa)) & "," & Str(obj.Coordinates(aa + 1)) & "," & Str(obj.Coordinates(aa + 2))

atst = DistanceBetween(obj.Coordinates(aa), obj.Coordinates(aa + 1), x, y)

If (atst_nustatytas = False) Then

min_atst = atst

atst_nustatytas = True

End If

If atst

min_atst = atst

taskas = aa

End If

Next aa

Else

MsgBox "Must select MLINE!"

Exit Sub

End If

Set perdavimui = obj.Copy

Set obj2 = perdavimui

 

'Exit Sub

For aa = 0 To UBound(obj.Coordinates) Step 3

'MsgBox obj.Coordinates(aa)

'MsgBox obj.Coordinates(aa + 1)

'MsgBox obj.Coordinates(aa + 2)

If aa >= taskas Then

dblVerticesCnt = dblVerticesCnt + 3

ReDim Preserve dblVertices(dblVerticesCnt)

dblVertices(dblVerticesCnt - 2) = obj.Coordinates(aa)

dblVertices(dblVerticesCnt - 1) = obj.Coordinates(aa + 1)

dblVertices(dblVerticesCnt) = obj.Coordinates(aa + 2)

End If

If aa

dblVerticesCnt2 = dblVerticesCnt2 + 3

ReDim Preserve dblVertices2(dblVerticesCnt2)

dblVertices2(dblVerticesCnt2 - 2) = obj2.Coordinates(aa)

dblVertices2(dblVerticesCnt2 - 1) = obj2.Coordinates(aa + 1)

dblVertices2(dblVerticesCnt2) = obj2.Coordinates(aa + 2)

End If

Next aa

If ThisDrawing.ActiveSpace = acModelSpace Then

If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices

If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2

Else

If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices

If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2

End If

obj.Update

obj2.Update

Exit Sub

eh:

MsgBox "Error number: " & str(Err.Number) & " . Description: " & Err.Description

End Sub