📄 frmanalyse.frm
字号:
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(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
'插入
step = depth
addToArray "fast_pmove " & ch3 & " " & 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
'拔出
step = -depth
addToArray "fast_pmove " & ch3 & " " & step & " ", instructionSquence()
End Sub
'#############################################################################
'修改边界坐标以适应边框
Private Sub modifyBoundary(PSquence() As CoordType, d As Double, layer As Long)
Dim i As Long
Dim PNum As Long
PNum = UBound(PSquence) + 1
Dim PGroup As Long
PGroup = PNum / 2
For i = 0 To PGroup - 1
PSquence(2 * i).CX = PSquence(2 * i).CX + d
PSquence(2 * i + 1).CX = PSquence(2 * i + 1).CX - d
Next i
End Sub
'#############################################################################
'回原点
Private Sub returnOrigin()
Dim pos1 As Long
Dim pos2 As Long
pos1 = -Last.CX
pos2 = -Last.CY
addToArray "find_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
Last.CX = 0
Last.CY = 0
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 Abs(x1 - x2) < 0.001 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) And IsNull(secLine.LK) Then
If Abs(firLine.LB - secLine.LB) <= 0.0001 Then
p = secLine.LEnd
End If
Else
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 Abs(firLine.LK - secLine.LK) <= 0.0001 Then
If Abs(firLine.LB - secLine.LB) <= 0.0001 Then
p = firLine.LEnd
End If
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
End If
If mode = 1 Then
getLine_LineIntersection = p
Else '方式0,默认方式
If firLine.LK - secLine.LK = 0 Then
getLine_LineIntersection.CX = -1 '约定，当返回值p.cx的值为-1时，扫描无效
Exit Function
End If
'判定这一点是否在这条线段内
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 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 Abs(p1.CX - p2.CX) < 0.00002 Then
If Abs(absConvex - 1) < 0.00001 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
p1.CX = b
p2.CX = b
approximation = r ^ 2 - (b - x0) ^ 2
If approximation < 0.0001 Then
approximation = 0
End If
If approximation >= 0 Then
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.0001 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，默认方式
If IsNull(k) Then
p1.CX = b
p2.CX = b
approximation = r ^ 2 - (b - x0) ^ 2
If approximation < 0.0001 Then
approximation = 0
End If
If approximation >= 0 Then
p1.CY = y0 + Sqr(approximation)
p2.CY = y0 - Sqr(approximation)
getLine_ArcIntersecti⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -