TheSwamp

Code Red => VB(A) => Topic started by: Atook on December 27, 2007, 02:08:54 PM

Title: Trouble with Curve.cls
Post by: Atook on December 27, 2007, 02:08:54 PM
I'm using Frank Oquendo's Curve.cls to put blocks evenly spaced along a polyline.

The trouble I'm having is retrieving the slope of the polyline (firstderivative).

        dblParameter = objCurve.GetParameterAtDistance(i * dblSpacing)
        dblRotation = objCurve.GetFirstDerivative(dblParameter) '<-crash here

When I run the code, the GetFirstDerivative method of Curve.cls returns empty. I believe the error is occurring at the .EvalLispExpression line or the one after it.

Anyone got any ideas for me?
Title: Re: Trouble with Curve.cls
Post by: Jeff_M on December 27, 2007, 07:16:46 PM
GetFirstDerivative returns a direction Vector as a  Variant array, not a double angle......so if your dblRotation is Dim'ed as a double, it will fail. If this isn't the problem, can you define your "crash" a bit more detailed?
Title: Re: Trouble with Curve.cls
Post by: Bryco on December 28, 2007, 09:19:14 AM
Try not to use the Curve class when it's not needed.
With a bit of error control this should get you there
Code: [Select]
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
Title: Re: Trouble with Curve.cls
Post by: Bryco on December 28, 2007, 09:22:19 AM
On testing this I found the acad divide command to be incorrect with a funky ucs (version 2008) quite a surprise. I've added a drawing to show it, the block to insert is "b". My code did the same until I added the block at 0,0,0 changed the normal to match the plines then changed it's insertionpoint to the correct one
Title: Re: Trouble with Curve.cls
Post by: Atook on December 28, 2007, 11:46:07 AM
Jeff, that's exactly the problem, thanks for the tip.

Bryco, I've been looking to avoid Curve.cls, but wasn't quite sure how to go about it. Thanks for the help! I'll probably take a closer look at it this weekend.