看见有人发示坡线程序，随手写一个

    AppActivate objCad.Caption
    Dim objPl1 As AcadLWPolyline, objPl2 As AcadLWPolyline, pt1 As Variant, blnESC As Boolean
    SelectSinglePLine objPl1, pt1, blnESC
    If blnESC Then Exit Sub
    SelectSinglePLine objPl2, pt1, blnESC
    If blnESC Then Exit Sub
    Dim dbl1 As Double, myPt1, myPt2, myPt3(2) As Double, i As Long
    dbl1 = ThisDrawing.Utility.GetReal("请输入示坡线间距：")
    Dim objCurve1 As New Curve, objCurve2 As New Curve
    Dim objL As AcadLine
    Set objCurve1.Entity = objPl1
    Set objCurve2.Entity = objPl2
    Do While i * dbl1 


dwyyhrd0yav.gif





[code]Private Sub Command23_Click()
    AppActivate objCad.Caption
    Dim objPl1 As AcadLWPolyline, objPl2 As AcadLWPolyline, pt1 As Variant, blnESC As Boolean
    SelectSinglePLine objPl1, pt1, blnESC
    If blnESC Then Exit Sub
    On Error GoTo err1
    Dim dbl1 As Double, myPt1, myPt2, myPt3, dblA As Double, i As Long
    dbl1 = 3
    dbl1 = ThisDrawing.Utility.GetReal("请输入示坡线间距：")
    Dim objCurve1 As New Curve
    Dim objL As AcadLine
    Set objCurve1.Entity = objPl1
    Dim DrtPt(2) As Double, ScdPt(2) As Double, FstPt(2) As Double, tmppt As Variant, lngDrt As Long
    tmppt = ThisDrawing.Utility.GetPoint(objCurve1.StartPoint, "请指定示坡方向：")
    DrtPt(0) = tmppt(0)
    DrtPt(1) = tmppt(1)
    DrtPt(2) = tmppt(2)
    tmppt = objCurve1.GetClosestPointTo(DrtPt)
    If Abs(tmppt(0) - DrtPt(0)) < EPS And Abs(tmppt(1) - DrtPt(1)) < EPS And Abs(tmppt(1) - DrtPt(1)) < EPS Then
        MsgBox "请不要用曲线上的点指定方向！", vbInformation + vbOKOnly, App.Title
        Exit Sub
    End If
    ScdPt(0) = objPl1.Coordinate(1)(0)
    ScdPt(1) = objPl1.Coordinate(1)(1)
    ScdPt(2) = 0
    FstPt(0) = objPl1.Coordinate(0)(0)
    FstPt(1) = objPl1.Coordinate(0)(1)
    FstPt(2) = 0
    lngDrt = Cmp_PolarAngel_arrP(DrtPt, ScdPt, FstPt) '取旋转方向
    Do While i * dbl1 < objCurve1.length
        myPt1 = objCurve1.GetPointAtDistance(i * dbl1)
        myPt2 = objCurve1.GetFirstDerivative(objCurve1.GetParameterAtDistance(i * dbl1))
        myPt2(0) = myPt1(0) + myPt2(0)
        myPt2(1) = myPt1(1) + myPt2(1)
        dblA = ThisDrawing.Utility.AngleFromXAxis(myPt1, myPt2) + lngDrt * PI / 2
        If i Mod 2 = 1 Then
            myPt3 = ThisDrawing.Utility.PolarPoint(myPt1, dblA, dbl1 / 2)
            Set objL = ThisDrawing.ModelSpace.AddLine(myPt1, myPt3)
        Else
            myPt3 = ThisDrawing.Utility.PolarPoint(myPt1, dblA, dbl1)
            Set objL = ThisDrawing.ModelSpace.AddLine(myPt1, myPt3)
        End If
        i = i + 1
    Loop
    ThisDrawing.Regen acActiveViewport
    Exit Sub
err1:
    Debug.Print Err.Number
    If Err.Number = -2145320928 Then
        Err.Clear
        Resume Next
    End If
End Sub