利用PPT-VBA和CAD的3dmesh命令绘制数学曲面

2024年1月9日发(作者：曹县2023年考试数学试卷)

利用PPT-VBA和CAD的3dmesh命令绘制数学曲面

最近一直用ppt-vba发展绘图方法，二维方法很容易就搞定了，但是三维方法却很难，只是做了一些初探。一个偶然的机会在网上看到了“利用Matlab通过Excel向CAD结合绘制数学曲面”和“直接用Excel向CAD传递数据”，我发现它们有共同的地方都是要经过Excel向CAD传递数据，与其这样还不如直接用excel-vba计算数据。经过几次改进，程序与Excel无关了（要经过一个txt文件保存数据），干脆放在ppt-vba里来完成正好完善我的绘图方法。

1 PPT-VBA生成的数据

（1） 生成iMax×jMax维行数组，其中以“，”隔开x、y和z坐标值

（2） 在桌边生成文件

（3） 程序如下

Option Base 1

Const pi# = 3.142

\'***********************************************************************************

\'*******************计算数据，由x、y和z的两个参数定义*******************

\'***********************************************************************************

Function xF#(u#, v#)

xF = u * Cos(v)

End Function

Function yF#(u#, v#)

yF = u * Sin(v)

End Function

Function zF#(u#, v#)

If u = 0 Then

zF = 10

Else

zF = 10 * Sin(u) / u

End If

End Function

Sub ToCAD3DMesh()

Dim u#, v#, uX#, uD#, vX#, vD#

Dim x#(), y#(), z#(), Data$()

Dim i%, j%, iMax%, jMax%

\'*******************************************************************************

\'*****************************定义参数u和v的范围*************************

\'********************定义初始和次要网面轴线的顶点数********************

\'*******************************************************************************

uX = 0: uD = 3 * pi

vX = -3 * pi: vD = 3 * pi

iMax = 21

jMax = 41

\'*******************************************************************************

\'*******************************************************************************

ReDim x#(iMax * jMax, 1), y#(iMax * jMax, 1), z#(iMax * jMax, 1),

Data$(iMax * jMax, 1)

For i = 1 To iMax

For j = 1 To jMax

u = (i - 1) * (uD - uX) / (iMax - 1) + uX

v = (vD - vX) / (jMax - 1) * (j - 1) + vX

x((i - 1) * jMax + j, 1) = xF(u, v)

y((i - 1) * jMax + j, 1) = yF(u, v)

z((i - 1) * jMax + j, 1) = zF(u, v)

Data((i - 1) * jMax + j, 1) = x((i - 1) * jMax + j, 1) & \",\" & y((i - 1) *

jMax + j, 1) & \",\" & z((i - 1) * jMax + j, 1)

Next j

Next i

SaveAs3DMesh_Txt iMax, jMax, Data

MsgBox \"CAD_3DMesh数据已导出，请在桌面查看数据文件\" &

Chr(13) & _

\"初始网面轴线的顶点数为\" & iMax & Chr(13) & _

\"次要网面轴线的顶点数为\" & jMax, vbInformation, \"导出CAD绘图数据\"

End Sub

Sub SaveAs3DMesh_Txt(iMax%, jMax%, Data$())

Dim i%

Dim ObjShell, Desktop_Path \'获取本台机子桌面路径

Set ObjShell = CreateObject(\"\")

Desktop_Path = lFolders(\"Desktop\")

Open Desktop_Path & \"\" For Output As #1

For i = 1 To iMax * jMax

Print #1, Data(i, 1)

Next

Close

End Sub

2 CAD的3dmesh用法（笔者用的是中望CAD的教育版）

（1） 输入3dmesh命令

（2） 输入初始网面轴线的顶点数（2到256之间）:iMax

（3） 输入次要网面轴线的顶点数（2到256之间）:jMax

（4） 复制桌面上的ShuJu文件到顶点（1，1）后面，数据加载完后自动绘图

（5） 在“视图三维视图”选择一种观察方式

（6） 保存时采用Windows截图要比bmpout命令好（还有更好的，那就是渲染到文件）

3 如图

笔者以前的博文《用Excel绘制数学曲面》也可作为参考，只是那比较粗糙，简单的可以用一下。