曲线有问题。cls公司

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  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 270
            If Dx 270
                dAng = pi + dAng '90->180
            Else '270->360
                dAng = 2 * pi + dAng
            End If
        Else
            If Dx 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