Option Explicit
Const pi = 3.14159265358979
Sub div()
    Dim vv As Variant
    Dim coord As Variant                        ' coordinates of the vertices
    Dim objent As AcadObject                    ' picked object
    Dim l As Boolean                            ' type of object _
                                                  true - lwpline _
                                                  false - 3d pline, pline
    Dim ro As Double
        ro = pi / 200           ' gon
        'ro = pi / 180          ' degree
    
    On Error Resume Next
        ' pick object
        ThisDrawing.Utility.GetEntity objent, vv, vbCrLf & "Choose Line: "
        
        ' determinate type of the object
        If (TypeOf objent Is AcadPolyline) Then
            Dim objPline As AcadPolyline
            Set objPline = objent
                l = True
                coord = objPline.Coordinates
        ElseIf (TypeOf objent Is Acad3DPolyline) Then
            Dim obj3Pline As Acad3DPolyline
            Set obj3Pline = objent
                l = True
                coord = obj3Pline.Coordinates
        ElseIf (TypeOf objent Is AcadLWPolyline) Then
            Dim objLWP As AcadLWPolyline
            Set objLWP = objent
                l = False
                coord = objLWP.Coordinates
        End If
'=============================
    On Error Resume Next
    
    Dim S As Double             ' length of the segment
    Dim alf As Double           ' bearing
    Dim i As Long, j As Long
        i = 0
        j = 0
    Dim dist2 As Double
    Dim dist As Double          ' distance for divide
        dist = ThisDrawing.Utility.GetReal(vbCrLf & "Enter Distance: ")
    Dim blk As String           ' name of block to insert
        blk = ThisDrawing.Utility.GetString(1, vbCrLf & "Enter block name: ")
        
    Dim nbr_of_segments As Long ' number of segments in selected pline
    Dim nbr_of_vertices As Long ' number of vertices in selected pline
        If l = True Then
            nbr_of_vertices = (UBound(coord) + 1) / 3
            nbr_of_segments = nbr_of_vertices - 1
        ElseIf l = False Then
            nbr_of_vertices = (UBound(coord) + 1) / 2
            nbr_of_segments = nbr_of_vertices - 1
        End If

    ' scale factors for the block and rotation
    Dim mx As Integer, my As Integer, mz As Integer, rot As Double
        mx = 1: my = 1: mz = 1: rot = 100
        
    Dim n As Long
    Dim ost As Double
    ' insertion coordinates of the block
    Dim insBlk(0 To 2) As Double
    Dim oBlk As AcadBlockReference  ' block
    
        Err.Clear
        
        If l = True Then            ' 3d polyline, polyline
            i = 0
            ost = 0
            ' to add this code
        ElseIf l = False Then       ' lwpolyline
            ost = 0
            For i = 0 To nbr_of_segments - 1
                alf = alfa1(coord(j + 1), coord(j + 3), coord(j), coord(j + 2))
                S = S1(coord(j + 1), coord(j + 3), coord(j), coord(j + 2))
                
                n = Int(S / dist)   ' number of blocks to insert
                dist2 = dist - ost
                
                Do
                    insBlk(0) = coord(j) + dist2 * Sin(alf * ro)        ' coordinates of the block
                    insBlk(1) = coord(j + 1) + dist2 * Cos(alf * ro)
                    insBlk(2) = 0
                    If dist2 < S Then
                        Set oBlk = ThisDrawing.ModelSpace.InsertBlock(insBlk, "a", mx, my, mz, rot)
                    End If
                    dist2 = dist2 + dist
                Loop While dist2 < S
                ost = S - (n * dist)
                j = j + 2  ' next vertex
            Next i
        End If
    
        If Err.Number <> 0 Then
            MsgBox Err.Number & " " & Err.Description & " " & Err.Source
        End If
End Sub
' ==================================================================
' calculate bearing between 2 points
' ==================================================================
Private Function alfa1(ByVal xa As Double, ByVal Xb As Double, ByVal ya As Double, ByVal Yb As Double) As Double
    Dim rumb As Double
    Dim dX As Double
    Dim dY As Double
        dX = Xb - xa
        dY = Yb - ya
        If dX > 0 And dY > 0 Then
            rumb = Atn(Abs(dY) / Abs(dX)) * 200 / pi
            alfa1 = rumb
        ElseIf dX < 0 And dY > 0 Then
            rumb = Atn(Abs(dY) / Abs(dX)) * 200 / pi
            alfa1 = 200 - rumb
        ElseIf dX < 0 And dY < 0 Then
            rumb = Atn(Abs(dY) / Abs(dX)) * 200 / pi
            alfa1 = 200 + rumb
        ElseIf dX > 0 And dY < 0 Then
            rumb = Atn(Abs(dY) / Abs(dX)) * 200 / pi
            alfa1 = 400 - rumb
        ElseIf dX = 0 And dY > 0 Then
            alfa1 = 100
        ElseIf dX < 0 And dY = 0 Then
            alfa1 = 200
        ElseIf dX = 0 And dY < 0 Then
            alfa1 = 300
        ElseIf dX > 0 And dY = 0 Then
            alfa1 = 0
        End If
End Function
' ==================================================================
' calculate distance between 2 points
' ==================================================================
Private Function S1(ByVal xa As Double, ByVal Xb As Double, ByVal ya As Double, ByVal Yb As Double) As Double
    Dim dX As Double
    Dim dY As Double
        dX = Xb - xa
        dY = Yb - ya
        S1 = Sqr((Abs(dY)) ^ 2 + (Abs(dX)) ^ 2)
End Function