Откладывание определенной длины на полилинии.

Option Explicit

'Tools->Options->General tab->Error Trrapping-->Break on Unhandled Errors
Sub demo()
Dim varPt
Dim oEnt As AcadEntity
Dim Util As AcadUtility
Dim pline As AcadLWPolyline
Dim dist As Double
Dim coords As Variant


Set Util = ThisDrawing.Utility


On Error GoTo Err_Control

With Util
dist = .GetDistance(, vbCrLf & "Enter a distance: ")

.GetEntity oEnt, varPt, vbLf & "Select polyline"
If Not TypeOf oEnt Is AcadLWPolyline Then
Exit Sub
End If
Set pline = oEnt
Dim z As Double
z = pline.Elevation
Dim norm As Variant
norm = pline.Normal
If pline.Length < dist Then
MsgBox "Distance exced a polyline length.Exit..."
Exit Sub
End If

coords = pline.Coordinates
Dim num As Integer
num = (UBound(coords) + 1) / 2
Dim i, n
Dim leng As Double
leng = 0#
n = 0
Dim sp As Variant
Dim ep As Variant

For i = 0 To num - 1

sp = pline.Coordinate(n)
ep = pline.Coordinate(n + 1)
leng = leng + Get_Distance(sp, ep)
If leng > dist Then
Exit For
End If


n = n + 1
Next
leng = leng - Get_Distance(sp, ep)
sp = pline.Coordinate(i)
ep = pline.Coordinate(i + 1)
Dim ang As Double
Dim spt(2) As Double
Dim ept(2) As Double
spt(0) = CDbl(sp(0)): spt(1) = CDbl(sp(1)): spt(2) = z:
ept(0) = CDbl(ep(0)): ept(1) = CDbl(ep(1)): ept(2) = z:
Dim p1 As Variant
Dim p2 As Variant

p1 = .TranslateCoordinates(spt, acOCS, acWorld, False, norm)
p2 = .TranslateCoordinates(ept, acOCS, acWorld, False, norm)
ang = .AngleFromXAxis(p1, p2)
Dim pt As Variant
pt = .PolarPoint(p1, ang, dist - leng)
pt = .TranslateCoordinates(pt, acWorld, acUCS, True, norm)
End With
ThisDrawing.ModelSpace.AddCircle pt, 1#


Exit_Here:
Exit Sub

Err_Control:
If Err.Description = "User input is keyword" Then
Resume Exit_Here
End If
End Sub

Public Function Get_Distance(fPoint As Variant, sPoint As Variant) As Double

     Dim x1 As Double, x2 As Double
     Dim y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double
     Dim cDist As Double

     x1 = CDbl(fPoint(0)): y1 = CDbl(fPoint(1))
     x2 = CDbl(sPoint(0)): y2 = CDbl(sPoint(1))

     cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
     Get_Distance = cDist

End Function