?? frmopen.frm
字號:
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
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -