modCoor.bas
Option Explicit
Public ptView As pt ' 视点
Public vNormal As pt ' 视平面法向量
Public vScrAxisX As pt ' 屏幕x轴的方向向量
Public vScrAxisY As pt ' 屏幕y轴的方向向量
Public ptAxis(5) As pt ' 坐标轴
Public sLongitude As Single ' 视角经度
Public sLatitude As Single ' 视角纬度
Public Type pt ' 点类型
x As Double
y As Double
z As Double
End Type
Public Type quaternion ' 四元数类型
' q = w + xi + yj + zk
w As Double
x As Double
y As Double
z As Double
End Type
Public pts() As pt, nPointNum As Integer
Public Const radconv As Double = 0.017453292519943
Public Const pi As Double = 3.14159265358979
Public Sub Main()
' 程序入口
Load frmMain
frmMain.Show
End Sub
Public Function initViewPos() As Long
' 初始化视点和视平面方向
' 返回: 1 成功
' 初始化视点
setPoint ptView, 0, 0, 0
' 初始化视平面方向
setPoint vNormal, 1, 0, 0
' 初始化屏幕坐标轴方向向量
setPoint vScrAxisX, 0, -1, 0
setPoint vScrAxisY, 0, 0, -1
initViewPos = 1
End Function
Public Function setViewPos(dNewViewX As Double, dNewViewY As Double, dNewViewZ As Double) As Long
' 设置视点
' 返回: 1 成功
setPoint ptView, dNewViewX, dNewViewY, dNewViewZ
setViewPos = 1
End Function
Public Function setNormalVector(dNewNormalX As Double, dNewNormalY As Double, dNewNormalZ As Double) As Long
' 设置视平面方向
' 返回: 1 成功
Dim dAng As Double, dSinAngHalf As Double, dCosThetaHalf As Double
Dim vRot As pt
Dim qRot As quaternion, qRot_counter As quaternion
Dim qAxisX As quaternion, qAxisY As quaternion
Dim qNewAxisX As quaternion, qNewAxisY As quaternion
' 计算屏幕坐标轴新的方向向量方法:
' 1.计算 θ=<vNormal,vNewNormal>, sin(θ/2), cos(θ/2);
' 2.计算 vRot=vNormal×vNewNormal;
' 3.构造四元数变换 qNewAxis=qRot*qAxis*(qRot*),其中
' qRot=(cos(θ/2),sin(θ/2)*vRot),
' qAxis=(0,vAxis.x,vAxis.y,vAxis.z),
' qRot*=(cos(θ/2),-sin(θ/2)*vRot),
' 求出qNewAxis;
' 4.求出vNewAxis.
' 1.
dAng = (vNormal.x * dNewNormalX + _
vNormal.y * dNewNormalY + _
vNormal.z * dNewNormalZ) / _
(Sqr(vNormal.x ^ 2 + vNormal.y ^ 2 + vNormal.z ^ 2) * _
Sqr(dNewNormalX ^ 2 + dNewNormalY ^ 2 + dNewNormalZ ^ 2))
If dAng = 0 Then
dAng = pi / 2
Else
dAng = Atn((1 - dAng ^ 2) / dAng)
If dAng < 0 Then dAng = dAng + pi
End If
dSinAngHalf = Sin(dAng / 2)
dCosThetaHalf = Cos(dAng / 2)
' 2.
setPoint vRot, vNormal.y * dNewNormalZ - dNewNormalY * vNormal.z, _


vNormal.z * dNewNormalX - vNormal.x * dNewNormalZ, _
vNormal.x * dNewNormalY - dNewNormalX * vNormal.y
' 3.
' 定义四元数
setQuat qRot, dCosThetaHalf, _
dSinAngHalf * vRot.x, dSinAngHalf * vRot.y, dSinAngHalf * vRot.z
setQuat qAxisX, 0, vScrAxisX.x, vScrAxisX.y, vScrAxisX.z
setQuat qAxisY, 0, vScrAxisY.x, vScrAxisY.y, vScrAxisY.z
setQuat qRot_counter, dCosThetaHalf, -qRot.x, -qRot.y, -qRot.z
' 代入四元数变换
' x 轴
setQuat qAxisX, _
qRot.w * qAxisX.w - qRot.x * qAxisX.x - qRot.y * qAxisX.y - qRot.z * qAxisX.z, _
qAxisX.x * qRot.w + qAxisX.w * qRot.x + qAxisX.y * qRot.z - qAxisX.z * qRot.y, _
qRot.w * qAxisX.y + qRot.y * qAxisX.w + qRot.x * qAxisX.z - qRot.z * qAxisX.x, _
qRot.w * qAxisX.z + qAxisX.w * qRot.z + qRot.y * qAxisX.x - qAxisX.y * qRot.x
setQuat qNewAxisX, _
qAxisX.w * qRot_counter.w - qAxisX.x * qRot_counter.x - qAxisX.y * qRot_counter.y - qAxisX.z * qRot_counter.z, _
qRot_counter.x * qAxisX.w + qRot_counter.w * qAxisX.x + qRot_counter.y * qAxisX.z - qRot_counter.z * qAxisX.y, _
qAxisX.w * qRot_counter.y + qAxisX.y * qRot_counter.w + qAxisX.x * qRot_counter.z - qAxisX.z * qRot_counter.x, _
qAxisX.w * qRot_counter.z + qRot_counter.w * qAxisX.z + qAxisX.y * qRot_counter.x - qRot_counter.y * qAxisX.x
' y 轴
setQuat qAxisY, _
qRot.w * qAxisY.w - qRot.x * qAxisY.x - qRot.y * qAxisY.y - qRot.z * qAxisY.z, _
qAxisY.x * qRot.w + qAxisY.w * qRot.x + qAxisY.y * qRot.z - qAxisY.z * qRot.y, _
qRot.w * qAxisY.y + qRot.y * qAxisY.w + qRot.x * qAxisY.z - qRot.z * qAxisY.x, _
qRot.w * qAxisY.z + qAxisY.w * qRot.z + qRot.y * qAxisY.x - qAxisY.y * qRot.x
setQuat qNewAxisY, _
qAxisY.w * qRot_counter.w - qAxisY.x * qRot_counter.x - qAxisY.y * qRot_counter.y - qAxisY.z * qRot_counter.z, _
qRot_counter.x * qAxisY.w + qRot_counter.w * qAxisY.x + qRot_counter.y * qAxisY.z - qRot_counter.z * qAxisY.y, _
qAxisY.w * qRot_counter.y + qAxisY.y * qRot_counter.w + qAxisY.x * qRot_counter.z - qAxisY.z * qRot_counter.x, _
qAxisY.w * qRot_counter.z + qRot_counter.w * qAxisY.z + qAxisY.y * qRot_counter.x - qRot_counter.y * qAxisY.x
' 4.
setPoint vScrAxisX, qNewAxisX.x, qNewAxisX.y, qNewAxisX.z
setPoint vScrAxisY, qNewAxisY.x, qNewAxisY.y, qNewAxisY.z
vScrAxisX = getUnitVector(vScrAxisX)
vScrAxisY = getUnitVector(vScrAxisY)
' 更新法向量坐标
setPoint vNormal, dNewNormalX, dNewNormalY, dNewNormalZ
'Debug.Print "axises:"; FormatNumber(vScrAxisX.x * vScrAxisY.x + vScrAxisX.y * vScrAxisY.y + vScrAxisX.z * vScrAxisY.z, 10)
'Debug.Print "x-vNormal:"; FormatNumber(vScrAxisX.x * vNormal.x + vScrAxisX.y * vNormal.y + vScrAxisX.z * vNormal.z, 10, vbTrue)


'Debug.Print "y-vNormal:"; FormatNumber(vScrAxisY.x * vNormal.x + vScrAxisY.y * vNormal.y + vScrAxisY.z * vNormal.z, 10, vbTrue)
setNormalVector = 1
End Function
Public Function setPoint(ptPoint As pt, dX As Double, dY As Double, Optional dZ As Double) As Long
' 设置点坐标
' 返回: 1 成功
ptPoint.x = dX: ptPoint.y = dY: ptPoint.z = dZ
setPoint = 1
End Function
Public Function setQuat(qQuater As quaternion, dW As Double, dX As Double, dY As Double, Optional dZ As Double) As Long
' 设置四元数的系数
' 返回: 1 成功
qQuater.w = dW: qQuater.x = dX: qQuater.y = dY: qQuater.z = dZ
setQuat = 1
End Function
Public Function getUnitVector(vVector As pt) As pt
' 返回 vVector 的单位向量
Dim dMod As Double
dMod = Sqr(vVector.x ^ 2 + vVector.y ^ 2 + vVector.z ^ 2)
setPoint getUnitVector, vVector.x / dMod, vVector.y / dMod, vVector.z / dMod
End Function
Public Function getProjectionPoint(ptSrc As pt) As pt
' 返回指定空间点在视平面上的投影点
Dim k As Double
k = (vNormal.x * (ptView.x - ptSrc.x) + _
vNormal.y * (ptView.y - ptSrc.y) + _
vNormal.z * (ptView.z - ptSrc.z)) / (vNormal.x ^ 2 + vNormal.y ^ 2 + vNormal.z ^ 2)
setPoint getProjectionPoint, _
ptSrc.x + k * vNormal.x, ptSrc.y + k * vNormal.y, ptSrc.z + k * vNormal.z
End Function
Public Function convertFrom3dTo2d(ptDest As pt, ptSrc As pt) As Long
' 将指定空间点坐标转换为视平面内的坐标
' 返回: 1 成功
Dim dX As Double, dY As Double, vTmp As pt
' OP - OO' = dX * vScrAxisX + dY * vScrAxisY
setPoint vTmp, ptSrc.x - ptView.x, ptSrc.y - ptView.y, ptSrc.z - ptView.z
dX = vScrAxisX.x * vTmp.x + vScrAxisX.y * vTmp.y + vScrAxisX.z * vTmp.z
dY = vScrAxisY.x * vTmp.x + vScrAxisY.y * vTmp.y + vScrAxisY.z * vTmp.z
setPoint ptDest, dX, dY
convertFrom3dTo2d = 1
End Function
Public Function drawAxis() As Long
' 重绘坐标轴
' 返回: 1 成功
Dim i As Integer, lColor As Long
Dim ptS1 As pt, ptS2 As pt, ptS3 As pt
Dim picArea As PictureBox
Set picArea = frmMain.picView
With frmMain.picView
.DrawWidth = 1
For i = 0 To UBound(ptAxis) Step 2
lColor = Switch(i = 0, vbRed, i = 2, vbGreen, i = 4, vbCyan)
convertFrom3dTo2d ptS1, getProjectionPoint(ptAxis(i))
convertFrom3dTo2d ptS2, getProjectionPoint(ptAxis(i + 1))
picArea.Line (ptS1.x, ptS1.y)-(ptS2.x, ptS2.y), lColor
If i = 0 Then ' 红箭头
setPoint ptS1, 5, -5, 0: setPoint ptS2, 5, 5, 0: setPoint ptS3, 10, 0, 0
ElseIf i = 2 Then ' 绿箭头
setPoint ptS1, -5, 5, 0: setPoint ptS2, 5, 5, 0: setPoint ptS3, 0, 10, 0


ElseIf i = 4 Then ' 蓝箭头
setPoint ptS1, -5, 0, 0: setPoint ptS2, 5, 0, 0: setPoint ptS3, 0, 0, 10
End If
convertFrom3dTo2d ptS1, getProjectionPoint(ptS1)
convertFrom3dTo2d ptS2, getProjectionPoint(ptS2)
convertFrom3dTo2d ptS3, getProjectionPoint(ptS3)
picArea.Line (ptS1.x, ptS1.y)-(ptS2.x, ptS2.y), lColor
picArea.Line -(ptS3.x, ptS3.y), lColor
picArea.Line -(ptS1.x, ptS1.y), lColor
Next
End With
drawAxis = 1
End Function
Public Function redrawGraph() As Long
' 重绘画面
' 返回: 1 成功
Dim i As Integer
Dim vTmp As pt, dAng As Double
Dim ptProj As pt, ptScreen As pt
frmMain.picView.Cls
' 重绘坐标轴
drawAxis
frmMain.picView.DrawWidth = 5
For i = 0 To nPointNum - 1
' 计算视点到该点的向量与法向量的夹角
setPoint vTmp, ptView.x - pts(i).x, ptView.y - pts(i).y, ptView.z - pts(i).z
dAng = (vTmp.x * vNormal.x + vTmp.y * vNormal.y + vTmp.z * vNormal.z) / _
(Sqr(vTmp.x ^ 2 + vTmp.y ^ 2 + vTmp.z ^ 2) * _
Sqr(vNormal.x ^ 2 + vNormal.y ^ 2 + vNormal.z ^ 2))
If dAng >= 0 Then
ptProj = getProjectionPoint(pts(i))
convertFrom3dTo2d ptScreen, ptProj
frmMain.picView.PSet (ptScreen.x, ptScreen.y), vbYellow
End If
Next
redrawGraph = 1
End Function
Public Function moveViewAngAt(ByVal sNewLati As Single, ByVal sNewLongi As Single) As Long
' 设置视角(视平面方向)
' 返回: 1 成功
Dim dNormalX As Double, dNormalY As Double, dNormalZ As Double
sLatitude = sNewLati
sLongitude = sNewLongi
' 对角度数值进行等效调整
If sLatitude < 0 Then
sLatitude = 360 - sLatitude Mod -360
ElseIf sLatitude > 360 Then
sLatitude = sLatitude Mod 360
End If
If sLongitude < 0 Then
sLongitude = 360 - sLongitude Mod -360
ElseIf sLongitude > 360 Then
sLongitude = sLongitude Mod 360
End If
' 设置视平面法向量(从视点指向以视点为球心、半径为 15 的球面)
dNormalX = Sin(sLatitude * radconv) * Cos(sLongitude * radconv)
dNormalY = Sin(sLatitude * radconv) * Sin(sLongitude * radconv)
dNormalZ = Cos(sLatitude * radconv)
setNormalVector dNormalX, dNormalY, dNormalZ
'dNormalDist = Sqr((dNormalX - dViewX) ^ 2 + (dNormalY - dViewY) ^ 2 + (dNormalZ - dViewZ) ^ 2)
End Function
Public Function moveViewAngBy(ByVal sLatiOffset As Single, ByVal sLongiOffset As Single) As Long
' 将视角偏移指定值
' 返回: 1 成功
moveViewAngAt sLatitude + sLatiOffset, sLongitude + sLongiOffset
End Function

frmMain.frm:
Option Explicit
Private Sub Form_Load()
' 初始化空间
initViewPos
' 设置坐标轴
setPoint ptAxis(0), -32768, 0, 0
setPoint ptAxis(1), 32767, 0, 0
setPoint ptAxis(2), 0, -32768, 0
setPoint ptAxis(3), 0, 32767, 0
setPoint ptAxis(4), 0, 0, -32768
setPoint ptAxis(5), 0, 0, 32767
' 设置视点和视平面位置
setViewPos -2, -2, 2
'setNormalVector 1, 0, 0
moveViewAngAt 120, 250
With picView
.BackColor = 0
.ScaleMode = vbPixels
.DrawWidth = 5
.AutoRedraw = True
.Left = 0
.Top = 0
End With
Me.Move (Screen.Width - Me.ScaleWidth) \ 2, (Screen.Height - Me.ScaleHeight) \ 2
tmrTime.Interval = 1
ReDim pts(2)
setPoint pts(0), 30, 0, 0
setPoint pts(1), 0, 30, 0
setPoint pts(2), 0, 0, 30
nPointNum = 3
End Sub
Private Sub Form_Resize()
Dim k As Single
picView.Width = Me.ScaleWidth
picView.Height = Me.ScaleHeight
If Me.ScaleWidth < Me.ScaleHeight Then
k = Me.ScaleWidth / 200
Else
k = Me.ScaleHeight / 200
End If
picView.Scale (-k, k)-(k, -k)
End Sub
Private Sub tmrTime_Timer()
' 检测按键情况
If GetAsyncKeyState(VK_LEFT) < 0 Then
moveViewAngBy 0, 2
ElseIf GetAsyncKeyState(VK_RIGHT) < 0 Then
moveViewAngBy 0, -2
End If
If GetAsyncKeyState(VK_UP) < 0 Then
moveViewAngBy -2, 0
ElseIf GetAsyncKeyState(VK_DOWN) < 0 Then
moveViewAngBy 2, 0
End If
' 重绘
redrawGraph
End Sub


modAPI.bas:
Option Explicit
' 用于检测按键情况
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Const VK_LEFT = &H25
Public Const VK_RIGHT = &H27
Public Const VK_UP = &H26
Public Const VK_DOWN = &H28

表示完全不懂，只能支持一下了~

学习之

完全看不懂
9L，你学到了什么？

我学会了定义变量。

曾经准备做过3d模拟，看到你的失败，我还是先发我的经验吧：
事实上，3d如果轴对的很准直线的话（即视角直线从前面到后面），并没有空心，那么结果肯定是最前面那块的2D图，如果你出来的是3D图，那是你想得太复杂了