frmanalyse.frm

一个不错的数控源码是vb的

                        nextArc = getArc(plnEty, i + 1)
                        nextArc.ARadius = getNextArcRadius(ps(i + 1), ps(0), plnEty.ECoord(i + 1), nextArc, dis, eleNum)
                        temp = getLine_ArcIntersection(thisLine, nextArc, 1)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    End If
                Else
                    thisLine = getLine(ps(i), ps(i + 1))
                    If plnEty.EConvex(i + 1) = 0 Then           '下一段为直线
                        nextLine = getLine(ps(i + 1), ps(i + 2))
                        tempEntity.ECoord(i + 1) = getLine_LineIntersection(thisLine, nextLine, 1)
                    Else                                        '下一段为弧
                        nextArc = getArc(plnEty, i + 1)
                        nextArc.ARadius = getNextArcRadius(ps(i + 1), ps(i + 2), plnEty.ECoord(i + 1), nextArc, dis, eleNum)
                        temp = getLine_ArcIntersection(thisLine, nextArc, 1)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    End If
                End If
            End If
            
                
        Else                                     '与下点间为弧
        
            If i = eleNum - 1 Then
                thisArc = getArc(plnEty, i)
                thisArc.ARadius = getNextArcRadius(ps(i), ps(0), plnEty.ECoord(i), thisArc, dis, eleNum)
                If plnEty.EConvex(0) = 0 Then          '下一段为直线
                    nextLine = getLine(ps(0), ps(1))
                    temp = getLine_ArcIntersection(nextLine, thisArc, 1)
                    tempEntity.ECoord(0) = getNearPoint(temp, plnEty.ECoord(0))
                Else                                        '下一段为弧
                    nextArc = getArc(plnEty, 0)
                    nextArc.ARadius = getNextArcRadius(ps(0), ps(1), plnEty.ECoord(0), nextArc, dis, eleNum)
                    temp = getArc_ArcIntersection(thisArc, nextArc)
                    tempEntity.ECoord(0) = getNearPoint(temp, plnEty.ECoord(0))
                End If
            Else
                If i = eleNum - 2 Then
                    thisArc = getArc(plnEty, i)
                    thisArc.ARadius = getNextArcRadius(ps(i), ps(i + 1), plnEty.ECoord(i), thisArc, dis, eleNum)
                    If plnEty.EConvex(i + 1) = 0 Then         '下一段为直线
                        nextLine = getLine(ps(i + 1), ps(0))
                        temp = getLine_ArcIntersection(nextLine, thisArc, 1)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    Else                                        '下一段为弧
                        nextArc = getArc(plnEty, i + 1)
                        nextArc.ARadius = getNextArcRadius(ps(i + 1), ps(0), plnEty.ECoord(i + 1), nextArc, dis, eleNum)
                        temp = getArc_ArcIntersection(thisArc, nextArc)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    End If
                Else
                  thisArc = getArc(plnEty, i)
                              If i = 5 Then
            i = 5
        End If
                    thisArc.ARadius = getNextArcRadius(ps(i), ps(i + 1), plnEty.ECoord(i), thisArc, dis, eleNum)

                    If plnEty.EConvex(i + 1) = 0 Then         '下一段为直线
                        nextLine = getLine(ps(i + 1), ps(i + 2))
                        temp = getLine_ArcIntersection(nextLine, thisArc, 1)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    Else                                        '下一段为弧
                        nextArc = getArc(plnEty, i + 1)
                        nextArc.ARadius = getNextArcRadius(ps(i + 1), ps(i + 2), plnEty.ECoord(i + 1), nextArc, dis, eleNum)
                        temp = getArc_ArcIntersection(thisArc, nextArc)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    End If
                End If
            End If
            
        End If
        
    Next i
    
    '修改 EConvex 的值
    For i = 0 To eleNum - 1
        
        If i = 4 Then
            i = 4
        End If
        
        
        If plnEty.EConvex(i) = 0 Then '与下点间为直线
            tempEntity.EConvex(i) = 0
        Else                                '下一段为弧
            tempEntity.EConvex(i) = getConvex(plnEty, i)
        End If
        
    Next i
    
    modifyPara = tempEntity
        
End Function
'###########################################
'实体pEty中，第p个节点的凸度
Private Function getConvex(pEty As EntityType, p As Long) As Double
    
    Dim i As Double
    Dim j As Double
    
    Dim lastAngle As Double
    Dim temp As CoordType
    Dim PI As Double
    PI = 3.141592653589
    
    If p < pEty.EPnum - 1 Then
        i = getDistance(pEty.ECoord(p), pEty.ECoord(p + 1))
    
        temp.CX = (pEty.ECoord(p).CX + pEty.ECoord(p + 1).CX) / 2
        temp.CY = (pEty.ECoord(p).CY + pEty.ECoord(p + 1).CY) / 2
    Else
        i = getDistance(pEty.ECoord(p), pEty.ECoord(0))
    
        temp.CX = (pEty.ECoord(p).CX + pEty.ECoord(0).CX) / 2
        temp.CY = (pEty.ECoord(p).CY + pEty.ECoord(0).CY) / 2
    End If
    
    j = getDistance(getArc(pEty, p).ACentre, temp)
    
    If j = 0 Then
        getConvex = 1
    Else
        angle = Atn(i / (2 * j))
        angle = angle * 2#
    
        lastAngle = 4# * (Atn(Abs(pEty.EConvex(p))))
    
        If (lastAngle - PI) > 0 Then
            getConvex = Tan((2 * PI - angle) / 4#)
        Else
            getConvex = Tan(angle / 4#)
        End If
    End If
    
    If pEty.EConvex(p) > 0 Then
        getConvex = Abs(getConvex)
    Else
        getConvex = -Abs(getConvex)
    End If
End Function

Private Function getNearLine(LnEqu As LineType, h As Double) As Variant

    Dim Line1 As LineType
    Dim Line2 As LineType
    
    Line1.LK = LnEqu.LK
    Line2.LK = LnEqu.LK
    
    If IsNull(LnEqu.LK) Then
        Line1.LB = LnEqu.LB + h
        Line2.LB = LnEqu.LB - h
    Else
        Line1.LB = LnEqu.LB + h * Sqr((LnEqu.LK ^ 2) + 1)
        Line2.LB = LnEqu.LB - h * Sqr((LnEqu.LK ^ 2) + 1)
    End If
    
    getNearLine = Array(Line1.LK, Line1.LB, Line2.LK, Line2.LB)
    
End Function
'#############################################################################
'求两个点的pointAry中，距离点p较近的一个点
Private Function getNearPoint(pointAry As Variant, p As CoordType) As CoordType
    
    Dim p1 As CoordType
    Dim p2 As CoordType
    
    p1.CX = pointAry(0)
    p1.CY = pointAry(1)
    p2.CX = pointAry(2)
    p2.CY = pointAry(3)
    
    Dim s1 As Double
    Dim s2 As Double
    
    s1 = getDistance(p1, p)
    s2 = getDistance(p2, p)
    
    If s1 < s2 Then
        getNearPoint.CX = p1.CX
        getNearPoint.CY = p1.CY
    Else
        getNearPoint.CX = p2.CX
        getNearPoint.CY = p2.CY
    End If
End Function
'#############################################################################
'处理实体的边缘
Private Sub dealEdge(ETElement As EntityType)
    Select Case ETElement.EName
    
        Case "CIRCLE"
            generateCircleEageInstruction ETElement
            
        Case "LINE"
            generateLineInstruction ETElement
            
        Case "POINT"
            generatePointInstruction ETElement
        
        Case "LWPOLYLINE"
            generateLwpolylineEageInstruction ETElement
        
    End Select
End Sub
'#############################################################################
'产生圆的指令，读到指令序列数组InstructionSquence中
Private Sub generateCircleEageInstruction(circleEntity As EntityType)
    
    Dim layer As Long
    Dim depth As Double
    Dim p As CoordType                  '圆心坐标
    Dim p0 As CoordType
    
    Dim radius As Double
    
    
    '"CIRCLE", p, depth, radius
    
    layer = circleEntity.ELayer
    
    depth = circleEntity.EDepth + SpaceHight
    
    radius = circleEntity.EConvex(0)
        
    
    '寻校准点
    p0.CX = circleEntity.ECoord(0).CX - radius + 3
    p0.CY = circleEntity.ECoord(0).CY
    
    pos1 = p0.CX - Last.CX
    pos2 = p0.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
            
    '插入
    step = depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()

    '寻起始点
    p.CY = circleEntity.ECoord(0).CY
    p.CX = circleEntity.ECoord(0).CX - radius
    pos1 = p.CX - Last.CX
    pos2 = p.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
    
    '画圆
    center1 = radius
    center2 = 0
    angle = -360
    addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & center1 & " " & center2 & " " & angle & " ", instructionSquence()
    
    '寻校准点
       
    pos1 = p0.CX - Last.CX
    pos2 = p0.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
    
    '拔出
    step = -depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
End Sub
'#############################################################################
'产生线的指令，读到指令序列数组InstructionSquence中
Private Sub generateLineInstruction(lineEntity As EntityType)
    ' "LINE", p1, p2, depth
    Dim p1 As CoordType
    Dim p2 As CoordType
    Dim depth As Double
    
    
    
    p1 = lineEntity.ECoord(0)
    p2 = lineEntity.ECoord(1)
    
    depth = lineEntity.EDepth + SpaceHight
    
    '寻点
    pos1 = p1.CX - Last.CX
    pos2 = p1.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
        
    '插入
    step = depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
        
    '画线
    pos1 = p2.CX - p1.CX
    pos2 = p2.CY - p1.CY
    addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    addToArray "cut_fast_line2 " & ch1 & " " & -pos1 & " " & ch2 & " " & -pos2 & " ", instructionSquence()
        
    '拔出
    step = -depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()

End Sub
'#############################################################################
'产生点的指令，读到指令序列数组InstructionSquence中
Private Sub generatePointInstruction(pointEntity As EntityType)

    ' "POINT", x, y, depth
    Dim p As CoordType
    Dim depth As Double
    
    
    
    
    p = pointEntity.ECoord(0)
    
    depth = pointEntity.EDepth + SpaceHight

    '寻点
    pos1 = p.CX - Last.CX
    pos2 = p.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
        
    '插入
    step = depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
                
    '拔出
    step = -depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
End Sub
'#############################################################################
'产生多线段的指令，读到指令序列数组InstructionSquence中
Private Sub generateLwpolylineEageInstruction(lwpolylineEntity As EntityType)
    Dim p As CoordType
    Dim p0 As CoordType
    
    
    
    
    Dim depth As Double
    
    Dim layer As Long
    Dim i As Long
    Dim p1 As CoordType
    Dim p2 As CoordType
    Dim thearc As ArcType
    
    depth = lwpolylineEntity.EDepth + SpaceHight
    
    Dim eleNum As Long
    eleNum = lwpolylineEntity.EPnum
    
    '寻校准点
    p0 = getCorrectPoint(lwpolylineEntity.ENum)
    pos1 = p0.CX - Last.CX
    pos2 = p0.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
            
    '插入
    step = depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
    
    '寻起始点
    p = lwpolylineEntity.ECoord(0)
    pos1 = p.CX - Last.CX
    pos2 = p.CY - Last.CY
    addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Last.CX = Last.CX + pos1
    Last.CY = Last.CY + pos2
    
    '走多线段
    For i = 0 To eleNum - 1             '按点序切
    
        p1 = lwpolylineEntity.ECoord(i)