用VB6进行Autocad的二次开发(原创)

fayadetudou

这个也太牛叉了吧，哎

zongfu_liu

努力学习，谢谢分享

睡醒的蜗牛

Public Sub getPlEachPartInfo(ByRef objPL As AcadLWPolyline, dblDistArr() As Double, dblMidPt() As Double, dblMidPt_NormalVector() As Double, dbl_Bugle_Radius() As Double)
    '取得多线段本身不提供的各段属性
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    'dblDistArr 各段距离
    'dblMidPt 各段中点
    'dblMidPt_NormalVector 各段中点法向量角度
    'dbl_Bugle_Radius 各段bugle的半径
    If objPL Is Nothing Then Exit Sub
    Dim i As Long
    Dim k As Double '斜率
    Dim dblA As Double, dblB As Double, dblC As Double '直线方程三系数
    Dim dblP1(2) As Double, dblP2(2) As Double, B_0_flag As Boolean '直线两点，及b=0标志
    Dim dblChord  As Double, dblSagitta As Double '弦长，拱高
    Dim dblMidPt_tmp As Variant, dblMidPt_tmp2(2) As Double '临时用中点
    Dim dblAngle_tmp As Double  '临时用角度
    ReDim dblDistArr((UBound(objPL.Coordinates) - LBound(objPL.Coordinates) + 1) \ 2 - 2)
    ReDim dblMidPt(UBound(objPL.Coordinates) - 2)
    ReDim dblMidPt_NormalVector((UBound(objPL.Coordinates) - LBound(objPL.Coordinates) + 1) \ 2 - 2)
    ReDim dbl_Bugle_Radius((UBound(objPL.Coordinates) - LBound(objPL.Coordinates) + 1) \ 2 - 2)
    Dim objDoc As AcadDocument
    Set objDoc = ThisDrawing()

    For i = 0 To UBound(dblDistArr)
        dblP1(0) = objPL.Coordinates(2 * i)
        dblP1(1) = objPL.Coordinates(2 * i + 1)
        dblP2(0) = objPL.Coordinates(2 * i + 2)
        dblP2(1) = objPL.Coordinates(2 * i + 3)

        If objPL.GetBulge(i) = 0 Then

            dblDistArr(i) = GetDist2D(dblP1(0), dblP1(1), dblP2(0), dblP2(1))

            dblMidPt(2 * i) = (dblP1(0) + dblP2(0)) / 2
            dblMidPt(2 * i + 1) = (dblP1(1) + dblP2(1)) / 2

            dblAngle_tmp = objDoc.Utility.AngleFromXAxis(dblP1, dblP2)
            dblMidPt_NormalVector(i) = PI / 2 + dblAngle_tmp

            dbl_Bugle_Radius(i) = 0
        ElseIf objPL.GetBulge(i) <> 0 Then
            dblChord = GetDist2D(dblP1(0), dblP1(1), dblP2(0), dblP2(1)) '求出弦长
            dblSagitta = Abs(dblChord / 2 * objPL.GetBulge(i)) '求出拱高
            dbl_Bugle_Radius(i) = (dblSagitta ^ 2 + (dblChord / 2) ^ 2) / dblSagitta / 2 '求出半径
            dblAngle_tmp = objDoc.Utility.AngleFromXAxis(dblP1, dblP2)
            dblMidPt_NormalVector(i) = -Sgn(objPL.GetBulge(i)) * PI / 2 + dblAngle_tmp   '始终在圆弧外面

            dblMidPt_tmp2(0) = (dblP1(0) + dblP2(0)) / 2
            dblMidPt_tmp2(1) = (dblP1(1) + dblP2(1)) / 2
            dblMidPt_tmp = objDoc.Utility.PolarPoint(dblMidPt_tmp2, dblMidPt_NormalVector(i), dblSagitta)
            dblMidPt(2 * i) = dblMidPt_tmp(0)
            dblMidPt(2 * i + 1) = dblMidPt_tmp(1)
            '''''
            dblDistArr(i) = dbl_Bugle_Radius(i) * Abs(Atn(objPL.GetBulge(i))) * 4

        End If
    Next i
    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
    Resume Next
End Sub