PrivateSubCommand1_Click()Caption="b样条曲面"CommonDialog1.Filter="数据文件*.txt|*.txt|(*.*)|*.*"CommonDialog1.ShowOpenfilehandle=FreeFile()ReDimXB(4,4),YB(4,4),ZB(4,4),P...
Private Sub Command1_Click()
Caption = "b样条曲面"
CommonDialog1.Filter = "数据文件*.txt|*.txt|(*.*)|*.*"
CommonDialog1.ShowOpen
filehandle = FreeFile()
ReDim XB(4, 4), YB(4, 4), ZB(4, 4), PX(4), PY(4), PZ(4)
ReDim UX(4), UY(4), UZ(4), XYZ(4), MAXZ(640)
Open CommonDialog1.FileName For Input As #filehandle
For I = 1 To 4: For J = 1 To 4: Input #filehandle, XB(I, J): Next J, I
For I = 1 To 4: For J = 1 To 4: Input #filehandle, YB(I, J): Next J, I
For I = 1 To 4: For J = 1 To 4: Input #filehandle, ZB(I, J): Next J, I
Close #filehandle
Pi = 3.14159: NL = 15: NP = 80: KX = 200: KZ = 200: dal = 1 / NL: dap = 1 / NP
ta = Pi / 8: ca = Cos(ta) / 2: Sa = Sin(ta) / 2
x0 = X1 / 2: y0 = Y1 * 1.5: b1 = G / 600
Call S56
End Sub
Private Sub S56()
14000 'sub双三次B样条曲面
Pic1.Cls
For I = 0 To 640: MAXZ(I) = -1000: Next
For I = 0 To NL: T = I * dal: LR = 1: Call S56a: '分量UV计算
For J = 0 To NP: T = J * dap: Call S56b: 'UV()
X = 0: Y = 0: Z = 0
For JJ = 1 To 4
X = X + XYZ(JJ) * PX(JJ): Y = Y + XYZ(JJ) * PY(JJ)
Z = Z + XYZ(JJ) * PZ(JJ)
Next JJ
Call S56c: II = J: Call S56d: '画曲线
Next J, I
For I = 0 To 640: MAXZ(I) = -1000: Next
For I = NL To 0 Step -1: T = I * dal: LR = 2: Call S56a: '分量UV计算
For J = 0 To NP: T = J * dap: Call S56b: 'UV()
X = 0: Y = 0: Z = 0
For JJ = 1 To 4
X = X + XYZ(JJ) * PX(JJ): Y = Y + XYZ(JJ) * PY(JJ)
Z = Z + XYZ(JJ) * PZ(JJ)
Next JJ
Call S56c: II = J: Call S56d: '画曲线
Next J, I
For I = 1 To 4: For J = 1 To 4
X = XB(I, J): Y = YB(I, J): Z = ZB(I, J): Call S56c: '点变换
X1 = x0 + ixx / 2: Y1 = y0 - izz / 2
If J = 1 Then Pic1.PSet (X1, Y1) Else Pic1.Line -(X1, Y1)
Next J, I
For J = 1 To 4: For I = 1 To 4
X = XB(I, J): Y = YB(I, J): Z = ZB(I, J): Call S56c: '点变换
X1 = x0 + ixx / 2: Y1 = y0 - izz / 2
If J = 1 Then Pic1.PSet (X1, Y1) Else Pic1.Line -(X1, Y1)
Next I, J
End Sub
Private Sub S56b()
14280 '分量 uv计算
XYZ(1) = (1 - T) ^ 3 / 6: XYZ(2) = (3 * T ^ 3 - 6 * T ^ 2 + 4) / 6
XYZ(3) = (-3 * T ^ 3 + 3 * T ^ 2 + 3 * T + 1) / 6: XYZ(4) = T ^ 3 / 6
End Sub
Private Sub S56a()
14320 'upor
Call S56b
For K = 1 To 4: UX(K) = 0: UY(K) = 0: UZ(K) = 0: Next
For K = 1 To 4: For L = 1 To 4
If LR = 1 Then
I1 = K: J1 = L
Else
I1 = L: J1 = K
End If
UX(K) = UX(K) + XYZ(L) * XB(J1, I1)
UY(K) = UY(K) + XYZ(L) * YB(J1, I1)
UZ(K) = UZ(K) + XYZ(L) * ZB(J1, I1)
Next L, K
For K = 1 To 4
PX(K) = UX(K): PY(K) = UY(K): PZ(K) = UZ(K)
Next
End Sub
Private Sub S56c()
14440 '点变换
ixx = (KX * (X + Y * ca)) * b1: izz = (KZ * (Z + Y * Sa)) * b1
End Sub
就是这个程序，就是在子程序 Private Sub S56()显示黄色，在子程序MAXZ(I) = 显示蓝色，提示编译错误，函数或者子程序未定义
展开
379
