frmanalyse.frm

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

        If i < eleNum - 1 Then          '未到达最后一点
            p2 = lwpolylineEntity.ECoord(i + 1)
        Else                          '到达最后一点
            p2 = lwpolylineEntity.ECoord(0)
        End If
            
        If lwpolylineEntity.EConvex(i) = 0 Then  '凸度为0，这一点与下一点间为直线
            pos1 = p2.CX - p1.CX
            pos2 = p2.CY - p1.CY
                
            addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
            
            Last.CX = Last.CX + pos1
            Last.CY = Last.CY + pos2
        Else                                    '凸度不为0，这一点与下点间为弧
            
            If i = 5 Then
                i = 5
            End If
            
            
            thearc = getArc(lwpolylineEntity, i)
            center1 = thearc.ACentre.CX - p1.CX
            center2 = thearc.ACentre.CY - p1.CY
            angle = thearc.AAngle
                
            addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & center1 & " " & center2 & " " & angle & " ", instructionSquence()
            
            Last.CX = p2.CX
            Last.CY = p2.CY
        End If
        
    Next i
    
    '寻校准点
   
    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
'#############################################################################
'按层处理图形的表面
Private Sub dealSurface(certainEntity As EntityType)
    '处理实体的表面
            
    Select Case certainEntity.EName
            
        Case "CIRCLE"
            generateCircleSurfaceInstruction certainEntity
                    
        Case "LWPOLYLINE"
            generateLwpolylineSurfaceInstruction certainEntity
                    
        Case Else:
            MsgBox "闭合曲线中包含无法识别的实体类型,详见帮助文档"

    End Select
        
End Sub
'#############################################################################
'产生处理圆表面指令
Private Sub generateCircleSurfaceInstruction(circleEntity As EntityType)

    Dim layer As Long
    Dim depth As Double
    Dim p As CoordType                  '圆心坐标
    
    Dim radius As Double
    
    
    
    
    
    
    '"CIRCLE", p, depth, radius
    
    layer = circleEntity.ELayer
    
    depth = circleEntity.EDepth + SpaceHight
        
    p = circleEntity.ECoord(0)
    radius = circleEntity.EConvex(0)
    
    '插入
    step = depth
    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
     
    '寻点
    pos1 = p.CX - radius - 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
       
    '向内进行扫底
    radius = radius - cutterWidth
        
    Do While radius >= 0
        pos1 = p.CX - radius - Last.CX
        pos2 = 0
        addToArray "wash_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
        Last.CX = Last.CX + pos1
        Last.CY = Last.CY + pos2            'last.cy没有被修改
        center1 = p.CX - Last.CX
        center2 = p.CY - Last.CY
        angle = -360
        addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & center1 & " " & center2 & " " & angle & " ", instructionSquence()
        radius = radius - cutterWidth
    Loop
       
    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()
        
End Sub

Private Sub generateLwpolylineSurfaceInstruction(lwpolylineEntity As EntityType)
    Dim i As Long
    
    Dim theScanner() As ScannerType   '每一层都有这样一个扫描器
    Dim scanLine As LineType          '扫描线
    Dim scanTimes As Long              '有效的扫描次数
    scanLine.LB = 0.0003
    scanLine.LK = 0
    
    Dim continueFlag As Boolean
    continueFlag = True
    Dim contactFlag As Boolean        '是否已经扫描到
    contactFlag = False
    Dim tempScanner As ScannerType
        
    While continueFlag = True
    
        continueFlag = False
    
        ReDim Preserve theScanner(scanTimes) As ScannerType
    
        arrayLines = 0
            
        tempScanner = scanLwpolyline(lwpolylineEntity, scanLine)
            
        '如果没有扫空
        If tempScanner.SAvailab Then
                
            '把这行扫描后得到的点序通过扫描器传给theScanner数组
            addPointSquenceToArray tempScanner.SSquence(), theScanner(scanTimes).SSquence()
                
            '置接触标志contactFlag为True
            contactFlag = True
            continueFlag = True
            
            theScanner(0).SDepth = lwpolylineEntity.EDepth
        Else
                    
            '如果已经扫描到多线段实体，而后扫空
            If contactFlag = True Then
                continueFlag = False
            Else
                continueFlag = True
            End If
                    
        End If
            
        
        If contactFlag = True Then scanTimes = scanTimes + 1
        
        scanLine.LB = scanLine.LB + cutterWidth - cutterWidth / 3.1
        
    Wend
    
    ReDim Preserve theScanner(scanTimes - 2)
        
    '产生这条多线段的指令
    theScanner(0).SLayer = lwpolylineEntity.ELayer
    generateInstructionOfThisLwpolyline theScanner()
    
End Sub
'#############################################################################
'用Ln扫描多线段实体theLwpolyline,得到这一行的一个扫描器
Private Function scanLwpolyline(theLwpolyline As EntityType, ln As LineType, Optional mode As Long) As ScannerType

    Dim certainLine As LineType
    Dim certainArc As ArcType
    
    Dim p1 As CoordType
    Dim p2 As CoordType
    
    Dim tempCoord As CoordType
    
    Dim i As Long
    Dim j As Long
    Dim eleNum As Long
    eleNum = theLwpolyline.EPnum
    Dim temp As Variant
        
    Dim pointCount As Long
    pointCount = 0
    
    Dim aa As Double
    aa = theLwpolyline.ELayer
    If aa = 1 Then
        aa = 1
    End If
    
    For i = 0 To eleNum - 1             '按点序切
    
        p1 = theLwpolyline.ECoord(i)
            
        If i < eleNum - 1 Then          '未到达最后一点
            p2 = theLwpolyline.ECoord(i + 1)
        Else                          '到达最后一点
            p2 = theLwpolyline.ECoord(0)
        End If
            
        If theLwpolyline.EConvex(i) = 0 Or mode = 1 Then '凸度为0，这一点与下一点间为直线
            
            certainLine = getLine(p1, p2)
            
            tempCoord = getLine_LineIntersection(certainLine, ln)
            
            If tempCoord.CX <> -1 Then
            
                ReDim Preserve scanLwpolyline.SSquence(pointCount) As CoordType
                scanLwpolyline.SSquence(pointCount) = tempCoord
                
                '下面的三行用于调试
                Dim a As Double
                a = tempCoord.CX
                a = tempCoord.CY
                
                scanLwpolyline.SAvailab = True
                pointCount = pointCount + 1
            End If
        End If
        
        If theLwpolyline.EConvex(i) <> 0 And mode = 0 Then      '凸度不为0，这一点与下点间为弧
        
            certainArc = getArc(theLwpolyline, i)
            
            temp = getLine_ArcIntersection(ln, certainArc)
            
            If UBound(temp) = 3 Then
                j = 0
            End If
                        
            For j = 0 To (UBound(temp) + 1) / 2 - 1
            
                If temp(0) <> -1 Then
                    ReDim Preserve scanLwpolyline.SSquence(pointCount) As CoordType
                    scanLwpolyline.SSquence(pointCount).CX = temp(j * 2)
                    scanLwpolyline.SSquence(pointCount).CY = temp(j * 2 + 1)
                    scanLwpolyline.SAvailab = True
                    pointCount = pointCount + 1
                    
                End If
                
            Next j
                
            
        End If
        
    Next i

End Function
'#############################################################################
'在表面处理中，产生这条多线段的指令
Private Sub generateInstructionOfThisLwpolyline(thisScanner() As ScannerType)

    Dim i As Long
    Dim j As Long
    Dim PNum As Long                   '每一行扫描线扫取的点数
    Dim nextpNum As Long
    Dim p1 As CoordType
    Dim p2 As CoordType
    
    Dim depth As Double
    depth = thisScanner(0).SDepth + SpaceHight
    
    
    
    
    
    For i = 0 To UBound(thisScanner)
        sortPointSquence thisScanner(i).SSquence()
    Next i
    
    '修正以防止碰到边界
    If thisScanner(0).SLayer = 2 Then
        i = 0
    End If
    
    For i = 0 To UBound(thisScanner)
        modifyBoundary thisScanner(i).SSquence(), 2#, thisScanner(0).SLayer
    Next i
    
    For i = 0 To UBound(thisScanner)
    
        PNum = UBound(thisScanner(i).SSquence) + 1
        
        If i Mod 2 = 0 Then
            p1 = thisScanner(i).SSquence(0)
        Else
            p1 = thisScanner(i).SSquence(PNum - 1)
        End If
    
        '寻点
        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
                        
        If i = 0 Then
            '插入
            step = depth
            addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
        End If
        
        If i Mod 2 = 0 Then     '当切至偶数行时
                                                        
            For j = 0 To PNum / 2 - 1   '分组
                
                Dim hi As Long
                hi = thisScanner(i).SLayer
                
                p1 = thisScanner(i).SSquence(2 * j)
                p2 = thisScanner(i).SSquence(2 * j + 1)
                
                '画线
                pos1 = p2.CX - p1.CX
                pos2 = p2.CY - p1.CY
                addToArray "wash_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
                Last.CX = Last.CX + pos1
                Last.CY = Last.CY + pos2
                
                If j Mod 2 = 0 And j <> PNum / 2 - 1 Then
                    
                    '拔出
                    step = -depth
                    addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
            
                    '挪刀
                    p1 = thisScanner(i).SSquence(2 * j + 1)
                    p2 = thisScanner(i).SSquence(2 * j + 2)
                    pos1 = p2.CX - p1.CX
                    pos2 = p2.CY - p1.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 If
                
                
            Next j
            
        Else                            '当切至奇数行时
        
            For j = 0 To (PNum - 2) / 2
            
                p1 = thisScanner(i).SSquence(PNum - 2 * j - 1)
                p2 = thisScanner(i).SSquence(PNum - 2 * j - 2)
                
                '画线
                pos1 = p2.CX - p1.CX