Try not to use the Curve class when it's not needed.
With a bit of error control this should get you there
Option Explicit
Const pi As Double = 3.14159265358979
Sub DividePoly()
Dim Ent As AcadEntity
Dim oPline As AcadLWPolyline
Dim cnt As Integer, CCnt As Integer
Dim Dist As Double, Tan As Double
Dim dLength As Double
Dim div As Integer
Dim unitL As Double
Dim i As Integer, j As Integer, K As Integer
Dim C1, C2, p
Dim C(5) As Variant
Dim dBulge As Double, Ang As Double
Dim Total As Double
Dim CoordCol As New Collection
Dim Elev As Double
Dim bBlock As Boolean
Dim oBref As AcadBlockReference
Dim sBlock As String
Dim Util As AcadUtility
Set Util = ThisDrawing.Utility
'Set Ent = EntSel("Select a pline to divide:")
Util.GetEntity Ent, p, "Select a pline to divide:"
If TypeOf Ent Is AcadLWPolyline Then
Set oPline = Ent
Else
MsgBox ("Must be a pline.")
Exit Sub
End If
On Error Resume Next
Dim keywordList As String
keywordList = "Block"
Util.InitializeUserInput 128, keywordList
Dim Answer As String
div = Util.GetInteger(vbCr & "Enter the number of segments or [Block]: ")
If Err Then
If StrComp(Err.Description, "User input is a keyword", 1) = 0 Then
Err.Clear
Answer = ThisDrawing.Utility.GetInput
If Answer = "Block" Then
bBlock = True
sBlock = Util.GetString(False, "Enter name of block to insert:")
If sBlock = "" Then Exit Sub
Dim oBlock As AcadBlock
Set oBlock = ThisDrawing.Blocks(sBlock)
If Err.Description = "Key not found" Then
Exit Sub
Else
div = Util.GetInteger(vbCr & "Enter the number of segments : ")
End If
Else: Exit Sub
End If
End If
End If
On Error GoTo 0
If Not div > 1 Then Exit Sub
unitL = oPline.Length / div
Elev = oPline.Elevation
cnt = (UBound(oPline.Coordinates) - 1) / 2
If oPline.Closed = True Then
CCnt = cnt + 1
Else
CCnt = cnt
End If
For i = 0 To CCnt - 1
C1 = oPline.Coordinate(i)
If i = cnt Then
C2 = oPline.Coordinate(0)
Else
C2 = oPline.Coordinate(i + 1)
End If
C(0) = C1: C(1) = C2
dLength = segLength(C1, C2)
C(5) = dLength
dBulge = oPline.GetBulge(i)
C(3) = dBulge
If dBulge <> 0 Then
'converting bulge to angle in radians ang=Atn(dBulge) * 4
Ang = Atn(dBulge) * 2
dLength = Ang * dLength / Sin(Ang)
C(4) = dLength
End If
Total = Total + dLength
C(2) = Total
CoordCol.Add C
Next i
dLength = 0
K = 1
For i = 1 To div - 1
dLength = dLength + unitL
For j = K To CCnt
If CoordCol(j)(2) >= dLength Then
Exit For
End If
Next j
If j > 1 Then
K = j - 1
Dist = dLength - CoordCol(K)(2)
Else
K = j
Dist = dLength
End If
dBulge = CoordCol(j)(3)
If dBulge = 0 Then
p = PtonLine(CoordCol(j)(0), CoordCol(j)(1), Dist, Tan)
Else
p = PtonArc(CoordCol(j), Dist, Tan)
End If
p(2) = Elev
p = ThisDrawing.Utility.TranslateCoordinates(p, acOCS, acWorld, 0, oPline.Normal)
If bBlock Then
Set oBref = ThisDrawing.ModelSpace.InsertBlock(p, sBlock, 1, 1, 1, Tan)
Dim Zero(2) As Double
oBref.Normal = oPline.Normal
oBref.InsertionPoint = p
Else
ThisDrawing.ModelSpace.AddPoint p
End If
Next i
End Sub
Function PtonLine(C1 As Variant, C2 As Variant, Dist As Double, Ang As Double) As Variant
'X = X1 + distance / dLength * DX
Dim X As Double, Y As Double
Dim Dx As Double, dY As Double
Dim dLength As Double
Dim p(2) As Double
X = C1(0): Y = C1(1)
Dx = C2(0) - X: dY = C2(1) - Y
dLength = Dist / Sqr(Dx * Dx + dY * dY)
p(0) = X + (dLength * Dx)
p(1) = Y + (dLength * dY)
PtonLine = p
Ang = AngFromX(C1, C2)
End Function
Function segLength(C1 As Variant, C2 As Variant) As Double
Dim Dx As Double, dY As Double
Dx = C2(0) - C1(0): dY = C2(1) - C1(1)
segLength = Sqr(Dx * Dx + dY * dY)
End Function
Function ArcLength(C1 As Variant, C2 As Variant, SegmentLength As Double, dBulge As Double) As Double
Dim Ang As Double
Ang = Atn(dBulge) * 2 'converting bulge to angle in radians ang=Atn(dBulge) * 4
ArcLength = Ang * SegmentLength / Sin(Ang)
End Function
Function PtonArc(C As Variant, Dist As Double, Tan As Double) As Variant
'X = X1 + distance / dLength * DX
Dim dBulge As Double
Dim dLength As Double
Dim p(2) As Double
Dim Ang As Double, Ang2 As Double
Dim Seg As Double
Dim segAng As Double, AngToCen
Dim Rad As Double
Dim CenPt(1) As Double
Dim C1, C2
Dim PosNeg As Integer
C1 = C(0): C2 = C(1)
dBulge = C(3)
Seg = C(5)
Ang = Atn(dBulge) * 2 'converting bulge to angle in radians= Atn(dBulge) * 4
Rad = Abs(Seg / (2 * Sin(Ang)))
segAng = AngFromX(C1, C2)
If dBulge > 0 Then
PosNeg = 1
AngToCen = segAng + ((0.5 * pi) - Ang)
Else
PosNeg = -1
AngToCen = segAng - ((0.5 * pi) + Ang)
End If
CenPt(0) = C1(0) + Cos(AngToCen) * Rad
CenPt(1) = C1(1) + Sin(AngToCen) * Rad
If AngToCen < pi Then
AngToCen = pi + AngToCen
Else
AngToCen = AngToCen - pi
End If
Ang = AngToCen + (Dist / Rad) * PosNeg
Tan = Ang + Sgn(dBulge) * pi * 0.5
Debug.Print "Ang", Ang, dBulge > 0
p(0) = CenPt(0) + (Cos(Ang) * Rad)
p(1) = CenPt(1) + (Sin(Ang) * Rad)
PtonArc = p
End Function
Public Function AngFromX(P1, P2) As Double
'If Not PointCheck(p1, p2) Then Exit Function
Dim Dx As Double, dY As Double
Dim dAng As Double
dY = P2(1) - P1(1): Dx = P2(0) - P1(0)
If Rd(dY, 0) Then 'Line is horizontal
If Rd(Dx, 0) Then Exit Function
If Dx > 0 Then
dAng = 0
Else
dAng = pi '180
End If
ElseIf Rd(Dx, 0) Then 'Line is vertical
If dY > 0 Then
dAng = 0.5 * pi '90
Else
dAng = 1.5 * pi '270
End If
Else
dAng = Atn(dY / Dx)
If dAng < 0 Then '90->270
If Dx < 0 Then '90->270
dAng = pi + dAng '90->180
Else '270->360
dAng = 2 * pi + dAng
End If
Else
If Dx < 0 And dY < 0 Then '180->270
dAng = pi + dAng
End If
End If
End If
AngFromX = dAng
End Function
Function Rd(num1 As Variant, num2 As Variant) As Boolean
If Abs(num1 - num2) < 0.00000001 Then Rd = True
End Function