frmopen.frm

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

                    codes = readTwoLines(EntitySectionArray())
            End Select
        End If
    Wend
    
End Sub
'#############################################################################
'由层决定处理文件中各个实体的次序
Private Sub readentityarrayToInstructionSquence()
    
    Dim cutTimes As Long
    Dim i As Long
    Dim maxDepth As Double
    
    For i = LBound(EntityArray) To UBound(EntityArray)
        
        '寻找最大厚度
        If EntityArray(i).ELayer = 0 Then
            maxDepth = EntityArray(i).EDepth
        End If
        
    Next i
    
    standHigh = Val(frmMain.Text1.Text) - maxDepth

    cutterWidth = Val(frmMain.txtCutterWidth.Text)
    
    If frmMain.Option1.Value = True Then
        cutWay = 1
        cutTimes = 0
    Else
        cutWay = 2
        cutTimes = 1
    End If
    
    For i = 0 To cutTimes
        
        cutWork i
        
    Next i
    
            
End Sub
Private Sub cutWork(times As Long)

    Dim maxLayer As Long
    Dim layer As Long
    Dim maxDepth As Double
    
    Dim i As Long
    Dim j As Long
    
    Last.CX = 0
    Last.CY = 0
    
    For i = LBound(EntityArray) To UBound(EntityArray)
        
        '寻找最大层号
        If EntityArray(i).ELayer >= maxLayer Then
            maxLayer = EntityArray(i).ELayer
        End If
        
    Next i
    
    
    '规定：
         '1.只有第零层只处理边缘
         '2.层号不为零的，按照层号的大小，从最大到最小处理
         '3.以层为单位处理图形表面,每层一般必须是一条闭合曲线
         
    For layer = maxLayer To 0 Step -1
        
        For j = LBound(EntityArray) To UBound(EntityArray)
                
            '处理实体的边缘
            If EntityArray(j).ELayer = layer Then
                    
                
                firPoint(0) = EntityArray(j).ECoord(0)
                    
                shrink EntityArray(j), cutterWidth / 2#
                    
                firPoint(1) = EntityArray(j).ECoord(0)
                
                If frmMain.Option2.Value = True And layer = 0 Then
                    If times = 0 Then
                        EntityArray(j).EDepth = EntityArray(j).EDepth / 2#
                    Else
                        EntityArray(j).EDepth = EntityArray(j).EDepth * 2#
                    End If
                End If
                    
                If layer = 0 And frmMain.Option1.Value = True And times = 0 Then
                    EntityArray(j).EDepth = EntityArray(j).EDepth + 3
                End If
                
                If layer = 0 And frmMain.Option2.Value = True And times = 1 Then
                    EntityArray(j).EDepth = EntityArray(j).EDepth + 3
                End If
                
                dealEdge EntityArray(j)
                                
                                
                '按层号处理图形表面
                If layer <> 0 And times = 0 Then
                    
                    shrink EntityArray(j), cutterWidth / 2# - 0.07
                    
                    If frmMain.optSwap1.Value = True Then
                        dealSurface layer
                    Else
                        standHigh = standHigh - 3
                        dealSurface layer
                        standHigh = standHigh + 3
                        dealSurface layer
                   End If
                    
                End If
                    
            End If
            
        Next j
    
    Next layer

    returnOrigin

End Sub
'#############################################################################
'把一个实体theEntity向内缩小distance
Private Sub shrink(theEntity As EntityType, distance As Double)

    Select Case theEntity.EName
    
        '在这个过程中，只有圆和多线段的参数被改动
        '其它实体类型的缩小以适应轮廓无意义
        
        Case "CIRCLE":
            shrinkCircle theEntity, distance
        
        Case "LWPOLYLINE":
            shrinkLwpolyline theEntity, distance
            
    End Select

End Sub
'#############################################################################
'把一个实体theCircle向内缩小distance
Private Sub shrinkCircle(theCircle As EntityType, d As Double)

    '圆的参数只是半径减小了
    theCircle.EConvex(0) = theCircle.EConvex(0) - d
    
End Sub
'#############################################################################
'把一个实体theLwpolyline向内缩小distance
Private Sub shrinkLwpolyline(theLwpolyline As EntityType, d As Double)

    Dim pn As Long
    Dim condition As Long
    Dim thisCondition As Long
    
    Dim girth As Double
    Dim minGirth As Double
    
    Dim lineEquation As LineType
    Dim Line1 As LineType
    Dim Line2 As LineType
    Dim lnEquAry() As LineType
    Dim PointSquence() As CoordType
    
    Dim temp As Variant
    
    Dim dis As Double
    
    Dim elementsNum As Long               '多线段中点的个数
    elementsNum = theLwpolyline.EPnum
    
    ReDim lnEquAry(elementsNum, 1)
    ReDim PointSquence(2 ^ (elementsNum) - 1, elementsNum)
        
    For pn = 0 To elementsNum - 1
            
        '假设实体为多边形,求出每两点间直线
        If pn < elementsNum - 1 Then
            lineEquation = getLine(theLwpolyline.ECoord(pn), theLwpolyline.ECoord(pn + 1))
        Else
            lineEquation = getLine(theLwpolyline.ECoord(pn), theLwpolyline.ECoord(0))
        End If
            
        '再求距离这些直线d的直线 (两条)
        temp = getNearLine(lineEquation, d)
        lnEquAry(pn, 0).LK = temp(0)
        lnEquAry(pn, 0).LB = temp(1)
        lnEquAry(pn, 1).LK = temp(2)
        lnEquAry(pn, 1).LB = temp(3)
            
    Next pn
        
    '依序求相邻直线的交点
    For condition = 0 To (2 ^ elementsNum) - 1
            
        For pn = 0 To elementsNum - 1
                
            If pn < elementsNum - 1 Then
                Line1 = lnEquAry(pn, Bin(condition, pn))
                Line2 = lnEquAry(pn + 1, Bin(condition, pn + 1))
            Else
                Line1 = lnEquAry(pn, Bin(condition, pn))
                Line2 = lnEquAry(0, Bin(condition, 0))
            End If
        
            PointSquence(condition, pn) = getLine_LineIntersection(Line1, Line2, 1)
        
        Next pn
        
    Next condition

    '穷举这些直线的所有组合，求周长最小的一组
    For condition = 0 To (2 ^ elementsNum) - 1
            
        girth = 0
            
        For pn = 0 To elementsNum - 1
            
            If pn < elementsNum - 1 Then
                dis = getDistance(PointSquence(condition, pn), PointSquence(condition, pn + 1))
            Else
                dis = getDistance(PointSquence(condition, pn), PointSquence(condition, 0))
            End If
                
            girth = girth + dis
                
        Next pn
            
        '求第一种情形的周长
        If condition = 0 Then
            minGirth = girth
        End If
            
        If girth < minGirth Then
            thisCondition = condition   '保存condition的值
            minGirth = girth            '用于调试目的
        End If
        
    Next condition
        
    theLwpolyline = modifyPara(theLwpolyline, PointSquence(), thisCondition, d)
    

End Sub
'#####################################
'修改缩小后实体的参数
Private Function modifyPara(plnEty As EntityType, PSquence() As CoordType, theCondition As Long, dis As Double) As EntityType
    
    Dim i As Long
    Dim j As Long
    Dim eleNum As Long         '多线段实体中点数组的上标
    eleNum = plnEty.EPnum
    
    Dim ps() As CoordType
    
    Dim thisLine As LineType
    Dim nextLine As LineType
    Dim thisArc As ArcType
    Dim nextArc As ArcType
    
    Dim temp As Variant
    
    Dim tempEntity As EntityType
    tempEntity = plnEty
    
    '把参数传递过来的点序列PSquence与边界对齐
    For i = 0 To eleNum - 1
        If i < eleNum - 1 Then
            ReDim Preserve ps(i + 1)
            ps(i + 1) = PSquence(theCondition, i)
        Else
            ps(0) = PSquence(theCondition, i)
        End If
    Next i
    
    '修改 ECoord 的值
    For i = 0 To eleNum - 1
        
        If plnEty.EConvex(i) = 0 Then '与下点间为直线
        
            If i = eleNum - 1 Then
                thisLine = getLine(ps(i), ps(0))
                If plnEty.EConvex(0) = 0 Then           '下一段为直线
                    nextLine = getLine(ps(0), ps(1))
                    tempEntity.ECoord(0) = getLine_LineIntersection(thisLine, nextLine, 1)
                Else                                        '下一段为弧
                    nextArc = getArc(plnEty, 0)
                    
                    
                    
                    nextArc.ARadius = nextArc.ARadius - dis
                    
                    
                    
                    temp = getLine_ArcIntersection(thisLine, nextArc, 1)
                    tempEntity.ECoord(0) = getNearPoint(temp, plnEty.ECoord(0))
                End If
            Else
                If i = eleNum - 2 Then
                    thisLine = getLine(ps(i), ps(i + 1))
                    If plnEty.EConvex(i + 1) = 0 Then           '下一段为直线
                        nextLine = getLine(ps(i + 1), ps(0))
                        tempEntity.ECoord(i + 1) = getLine_LineIntersection(thisLine, nextLine, 1)
                    Else                                        '下一段为弧
                        nextArc = getArc(plnEty, i + 1)
                        nextArc.ARadius = nextArc.ARadius - dis
                        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 = nextArc.ARadius - dis
                        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 = thisArc.ARadius - dis
                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 = nextArc.ARadius - dis
                    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 = thisArc.ARadius - dis
                    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 = nextArc.ARadius - dis
                        temp = getArc_ArcIntersection(thisArc, nextArc)
                        tempEntity.ECoord(i + 1) = getNearPoint(temp, plnEty.ECoord(i + 1))
                    End If
                Else
                    thisArc = getArc(plnEty, i)
                    thisArc.ARadius = thisArc.ARadius - dis
                    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 = nextArc.ARadius - dis
                        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 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