📄 frmopen.frm
字号:
Else '当切至奇数行时
For j = 0 To (pNum - 2) / 2
p1 = thisScanner(i).SSquence(pNum - 2 * j - 1)
p2 = thisScanner(i).SSquence(pNum - 2 * j - 2)
'画线
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(j + 2)
p2 = thisScanner(i).SSquence(j + 1)
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
If j = pNum - 2 And i < UBound(thisScanner) Then
p1 = p2
p2 = thisScanner(i + 1).SSquence(0)
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
End If
End If
Next i
'拔出
ch = 3
step = -depth
addToArray "fast_pmove " & ch & " " & step & " ", InstructionSquence()
End Sub
'#############################################################################
'回原点
Private Sub returnOrigin()
Dim ch1 As Long
Dim ch2 As Long
Dim pos1 As Long
Dim pos2 As Long
ch1 = 1
ch2 = 2
pos1 = -Last.CX
pos2 = -Last.CY
addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", InstructionSquence()
End Sub
'#############################################################################
'根据点的横坐标把数组ps中点进行从小到大排序
Private Sub sortPointSquence(ps() As CoordType)
Dim i As Long
Dim j As Long
Dim temp As Double
Dim eleNum As Long
eleNum = UBound(ps) + 1
For i = 0 To eleNum - 1
For j = 0 To eleNum - i - 2
If ps(j).CX > ps(j + 1).CX Then
temp = ps(j).CX
ps(j).CX = ps(j + 1).CX
ps(j + 1).CX = temp
End If
Next j
Next i
End Sub
'#############################################################################
'求p1和p2两点间的距离
Private Function getDistance(p1 As CoordType, p2 As CoordType) As Double
getDistance = Sqr((p1.CX - p2.CX) ^ 2 + (p1.CY - p2.CY) ^ 2)
End Function
'#############################################################################
'根据已知两点firPoint和secPoint求过这两点的直线
Private Function getLine(firPoint As CoordType, secPoint As CoordType) As LineType
Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double
getLine.LBegin = firPoint
getLine.LEnd = secPoint
x1 = firPoint.CX
y1 = firPoint.CY
x2 = secPoint.CX
y2 = secPoint.CY
If x1 = x2 Then
getLine.LK = Null
getLine.LB = x1
Else
getLine.LK = (y2 - y1) / (x2 - x1)
getLine.LB = y1 - getLine.LK * x1
End If
End Function
'#############################################################################
'求两条直线firLine和secLine的交点
Private Function getLine_LineIntersection(firLine As LineType, secLine As LineType, Optional mode As Long) As CoordType
Dim p As CoordType
Dim s As Double
Dim s1 As Double
Dim s2 As Double
Dim temp As Double
Dim b1 As Boolean
Dim b2 As Boolean
Dim b3 As Boolean
Dim b4 As Boolean
If IsNull(firLine.LK) Then
p.CX = firLine.LB
p.CY = secLine.LK * p.CX + secLine.LB
Else
If IsNull(secLine.LK) Then
p.CX = secLine.LB
p.CY = firLine.LK * p.CX + firLine.LB
Else
If firLine.LK - secLine.LK = 0 Then
getLine_LineIntersection.CX = -1 '约定，当返回值p.cx的值为-1时，扫描无效
Exit Function
Else
p.CX = (secLine.LB - firLine.LB) / (firLine.LK - secLine.LK)
p.CY = firLine.LK * p.CX + firLine.LB
End If
End If
End If
If mode = 1 Then
getLine_LineIntersection = p
Else '方式0,默认方式
'判定这一点是否在这条线段内
s = getDistance(firLine.LBegin, firLine.LEnd)
s1 = getDistance(p, firLine.LBegin)
s2 = getDistance(p, firLine.LEnd)
temp = s - s1 - s2
If Abs(temp - 0.0001) < 0.001 Then
temp = 0
End If
b1 = p.CX <> firLine.LBegin.CX
b2 = p.CY <> firLine.LBegin.CY
b3 = p.CX <> firLine.LEnd.CX
b4 = p.CY <> firLine.LEnd.CY
If (temp = 0) And (b1 Or b2) And (b3 Or b4) Then
getLine_LineIntersection = p
Else
getLine_LineIntersection.CX = -1
End If
End If
End Function
'###########################################
'根据两点及所夹弧的凸度求这段圆弧的参数
Private Function getArc(pEty As EntityType, pn As Long) As ArcType
Dim p1 As CoordType
Dim p2 As CoordType
Dim tempConvex As Double '由参数传递过来的凸度
Dim absConvex As Double '凸度的绝对值
Dim angle As Double '包含角的角度制
Dim radian As Double '包含角的弧度制
Dim eleNum As Long '多线段实体中点数组的上标
eleNum = pEty.EPnum
Dim PI As Double
PI = 3.14159265358979
p1 = pEty.ECoord(pn)
getArc.ABegin = p1
If pn < eleNum - 1 Then '未到达最后一点
p2 = pEty.ECoord(pn + 1)
Else '到达最后一点
p2 = pEty.ECoord(0)
End If
getArc.AEnd = p2
tempConvex = pEty.EConvex(pn)
absConvex = Abs(tempConvex)
angle = 4# * (Atn(absConvex) * 180# / PI)
getArc.AAngle = angle
If pEty.EConvex(pn) > 0 Then
getArc.AAngle = -angle
End If
radian = 4# * (Atn(absConvex))
If (radian - PI) > 0 Then
radian = 2# * PI - radian
End If
If (p1.CX - p2.CX) = 0 Then
If (absConvex - 1) = 0 Then
getArc.ACentre.CX = p1.CX
Else
If (((p2.CY > p1.CY) And (absConvex > 1#) And (tempConvex > 0#)) _
Or ((p2.CY > p1.CY) And (absConvex < 1#) And (tempConvex < 0#)) _
Or ((p2.CY < p1.CY) And (absConvex > 1#) And (tempConvex < 0#)) _
Or ((p2.CY < p1.CY) And (absConvex < 1#) And (tempConvex > 0#))) Then
getArc.ACentre.CX = p1.CX + Abs(p1.CY - p2.CY) / (2# * (Tan(radian / 2#)))
Else
getArc.ACentre.CX = p1.CX - Abs(p1.CY - p2.CY) / (2# * (Tan(radian / 2#)))
End If
End If
getArc.ACentre.CY = (p1.CY + p2.CY) / 2#
Else
If absConvex = 1# Then
getArc.ACentre.CY = (p1.CY + p2.CY) / 2#
Else
If (((p1.CX > p2.CX) And (absConvex > 1#) And (tempConvex > 0#)) _
Or ((p1.CX > p2.CX) And (absConvex < 1#) And (tempConvex < 0#)) _
Or ((p1.CX < p2.CX) And (absConvex > 1#) And (tempConvex < 0#)) _
Or ((p1.CX < p2.CX) And (absConvex < 1#) And (tempConvex > 0#))) Then
getArc.ACentre.CY = ((p1.CY + p2.CY) / 2#) + Abs(p1.CX - p2.CX) / (2# * Tan(radian / 2#))
Else
getArc.ACentre.CY = ((p1.CY + p2.CY) / 2#) - Abs(p1.CX - p2.CX) / (2# * Tan(radian / 2#))
End If
End If
getArc.ACentre.CX = (p1.CX + p2.CX) / 2# + (p2.CY - p1.CY) * (getArc.ACentre.CY - (p1.CY + p2.CY) / 2#) / (p1.CX - p2.CX)
End If
getArc.ARadius = getDistance(p1, getArc.ACentre)
End Function
'###########################################
'求直线和圆弧的交点
Private Function getLine_ArcIntersection(ln As LineType, arc As ArcType, Optional mode As Long) As Variant
Dim r As Double
Dim x0 As Double
Dim y0 As Double '弧的参数
Dim k As Variant
Dim b As Double '直线方程的参数
Dim p1 As CoordType
Dim p2 As CoordType '两个交点的坐标
Dim L As Double
Dim M As Double
Dim N As Double
Dim Q As Double '一些用于中途计算的宏
Dim temp As Double
Dim approximation As Double
Dim kb As Variant '起始点与圆心所成直线的斜率
Dim ke As Variant '终点与圆心所成直线的斜率
Dim ab As Double
Dim ae As Double
Dim ap1 As Double
Dim ap2 As Double
'先以圆方程计算，求得可能存在的交点
k = ln.LK
b = ln.LB
r = arc.ARadius
x0 = arc.ACentre.CX
y0 = arc.ACentre.CY
If mode = 1 Then
If IsNull(k) Then '这种情况只有在方式1下才可能出现
p1.CX = b
p2.CX = b
approximation = r ^ 2 - (b - x0) ^ 2
If approximation < 0.0001 Then
approximation = 0
p1.CY = y0 + Sqr(approximation)
p2.CY = y0 - Sqr(approximation)
End If
getLine_ArcIntersection = Array(p1.CX, p1.CY, p2.CX, p2.CY)
Else
L = k ^ 2 + 1
M = 2 * k * (b - y0) - 2 * x0
N = x0 ^ 2 + (b - y0) ^ 2 - r ^ 2
Q = M ^ 2 - 4 * L * N
If Q <= 0.001 Then
Q = 0
End If
p1.CX = (-M + Sqr(Q)) / (2 * L)
p2.CX = (-M - Sqr(Q)) / (2 * L)
p1.CY = k * p1.CX + b
p2.CY = k * p2.CX + b
getLine_ArcIntersection = Array(p1.CX, p1.CY, p2.CX, p2.CY)
End If
Else '方式0，默认方式
L = k ^ 2 + 1
M = 2 * k * (b - y0) - 2 * x0
N = x0 ^ 2 + (b - y0) ^ 2 - r ^ 2
Q = M ^ 2 - 4 * L * N
If Q - 0.00001 < 0# Then '没有交点
getLine_ArcIntersection = Array(-1, -1) '或交点唯一
Exit Function '退出
Else
p1.CX = (-M + Sqr(Q)) / (2 * L)
p2.CX = (-M - Sqr(Q)) / (2 * L)
p1.CY = k * p1.CX + b
p2.CY = k * p2.CX + b
End If
'在方式0中，如果有交点，判定这些点是否在弧上
If arc.AAngle - 360# = 0 Then
getLine_ArcIntersection = Array(p1.CX, p1.CY, p2.CX, p2.CY)
Exit Function
Else
If arc.AAngle < 0 Then
ab = getAngle(arc.ABegin, arc.ACentre)
ae = getAngle(arc.AEnd, arc.ACentre)
Else
ae = getAngle(arc.ABegin, arc.ACentre)
ab = getAngle(arc.AEnd, arc.ACentre)
End If
ap1 = getAngle(p1, arc.ACentre)
ap2 = getAngle(p2, arc.ACentre)
If ab > ae And ae = 0 Then
ae = 360#
End If
If ab < ae Then
If (⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -