frmopen.frm

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

                
            addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & cen1 & " " & cen2 & " " & angle & " )", InstructionSquence()
            
            Last.CX = p2.CX
            Last.CY = p2.CY
        End If
        
    Next i
    
    '寻校准点
    ch1 = 1
    ch2 = 2
    p = getCorrectPoint()
    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
    
    '拔出
    ch = 3
    step = -depth
    addToArray "fast_pmove " & ch & " " & step & " ", InstructionSquence()

End Sub
'#############################################################################
'按层处理图形的表面
Private Sub dealSurface(layer As Long)
    
    Dim i As Long
    
    For i = LBound(EntityArray) To UBound(EntityArray)
            
        '处理实体的边缘
        If EntityArray(i).ELayer = layer Then
            
            Select Case EntityArray(i).EName
            
                Case "CIRCLE"
                    generateCircleSurfaceInstruction EntityArray(i)
                    
                Case "LWPOLYLINE"
                    generateLwpolylineSurfaceInstruction EntityArray(i)
                    
                Case Else:
                    MsgBox "闭合曲线中包含无法识别的实体类型,详见帮助文档"

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

    Dim layer As Long
    Dim depth As Double
    Dim p As CoordType                  '圆心坐标
    Dim angle As Double
    Dim radius As Double
    
    Dim ch As Long
    Dim ch1 As Long
    Dim ch2 As Long
    Dim step As Double
    Dim cen1 As Double
    Dim cen2 As Double
    Dim pos1 As Double
    Dim pos2 As Double
    
    '"CIRCLE", p, depth, radius
    
    layer = circleEntity.ELayer
    
    depth = circleEntity.EDepth + standHigh
        
    p = circleEntity.ECoord(0)
    radius = circleEntity.EConvex(0)
    
    '寻点
    ch1 = 1
    ch2 = 2
    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
        
    '插入
    ch = 3
    step = depth
    addToArray "fast_pmove " & ch & " " & step & " ", InstructionSquence()
        
    '向内进行扫底
    ch1 = 1
    ch2 = 2
    cen1 = p.CX - Last.CX
    cen2 = p.CY - Last.CY
    angle = 360
        
    addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & cen1 & " " & cen2 & " " & angle & " )", InstructionSquence()
    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没有被修改
        cen1 = p.CX - Last.CX
        cen2 = p.CY - Last.CY
        angle = 360
        addToArray "wash_fast_arc_center " & ch1 & " " & ch2 & " " & cen1 & " " & cen2 & " " & angle & " )", InstructionSquence()
        radius = radius - cutterWidth
    Loop
    
    '拔出
    ch = 3
    step = -depth
    addToArray "fast_pmove " & ch & " " & 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.03
    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()
    
    
    '下面的代码用于调试
    '''''''''''''''''''''''''''''''''''''''''''''''''
    For i = 0 To UBound(theScanner)
        sortPointSquence theScanner(i).SSquence()
    Next i
    
    Dim j As Long
    
    For i = 0 To UBound(theScanner)
        
        For j = 0 To UBound(theScanner(i).SSquence)
            
            List1.AddItem (theScanner(i).SSquence(j).CX & "   " & theScanner(i).SSquence(j).CY)
            
        Next j
        
        List1.AddItem ("  ")
        
    Next i
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    
End Sub
'#############################################################################
'用Ln扫描多线段实体theLwpolyline,得到这一行的一个扫描器





'这一段渴望得到优化











Private Function scanLwpolyline(theLwpolyline As EntityType, ln As LineType) 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

    
    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 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
            
        Else                                    '凸度不为0，这一点与下点间为弧
        
            certainArc = getArc(theLwpolyline, i)
            
            temp = getLine_ArcIntersection(ln, certainArc)
            
            For j = 0 To UBound(temp) - 1
            
                If temp(0) <> -1 Then
                    ReDim Preserve scanLwpolyline.SSquence(pointCount) As CoordType
                    scanLwpolyline.SSquence(pointCount).CX = temp(j)
                    scanLwpolyline.SSquence(pointCount).CY = temp(j + 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
    If cutWay = 1 Then
        depth = thisScanner(0).SDepth + standHigh
    Else
        depth = thisScanner(0).SDepth / 2# + standHigh
    End If
    Dim pos1 As Double
    Dim pos2 As Double
    Dim ch As Long
    Dim ch1 As Long
    Dim ch2 As Long
    Dim step As Double
    
    For i = 0 To UBound(thisScanner)
        sortPointSquence thisScanner(i).SSquence()
    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
    
        '寻点
        ch1 = 1
        ch2 = 2
        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
            '插入
            ch = 3
            step = depth
            addToArray "fast_pmove " & ch & " " & step & " ", InstructionSquence()
        End If
        
        If i Mod 2 = 0 Then     '当切至偶数行时
                                                        
            For j = 0 To pNum / 2 - 1
            
                p1 = thisScanner(i).SSquence(2 * j)
                p2 = thisScanner(i).SSquence(2 * j + 1)
                
                '画线
                ch1 = 1
                ch2 = 2
                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
                    
                    '拔出
                    ch = 3
                    step = -depth
                    addToArray "fast_pmove " & ch & " " & 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
                
                    '插入
                    ch = 3
                    step = depth
                    addToArray "fast_pmove " & ch & " " & step & " ", InstructionSquence()
                    
                End If
                
                
            Next j