Question

CAD 编程 用VBA编写dvb 有文件的 帮忙啊帮忙啊 感谢感谢感谢

有题目要求的（有题目所需的资料）
源程序(一个程序框架)已存于：“exam”目录中，源程序名为：exam.dvb，在相应的子程序中写入对应的代码。
两个3D实体建模的详细要求请点击上页中相应的示意图。
各菜单项所对应的子程序名如下图所示。

Answer 1

今天我可以给你一个总程序：即生成你需要的菜单总程序，一个dvb文件。

当然，当你点击菜单时，只能弹出一个对话框而没有功能性程序，这只是一个测试。

但，总的程序有了，菜单能生成了，你只需要相应的模块中填上所需的源代码即可。

如需要，来个邮箱。

追问

能加下QQ吗？或者我文件能发下你的邮箱？

追答

我将我用的一个DVB修改了一下给你一个框架,具体功能模块没有而只有一个生成菜单的功能.如需要,给一个邮箱.

追问

249474497@qq.com
编程题目的要求大概是这样：
源程序(一个程序框架)已存于：“exam”目录中，源程序名为：exam.dvb，在相应的子程序中写入对应的代码。
两个3D实体建模的详细要求请点击上页中相应的示意图。
各菜单项所对应的子程序名如下图所示。

追答

这个符合要求吗：

追问

能发我看下吗？谢谢

追答

有一个调试视频发你邮箱了。

追问

好像没收到啊。。。能发下程序给我吗？急需。。。谢谢！！！！！！
249474497@qq.com

Answer 2

这不是我之前帮别人弄过的嘛，又看到了，呵呵，要写菜单，后面还要弄个几个命令；当初叫我帮忙写的兄弟可是。。。。，不说咯
你运气好，幸好没删哦；还有一个空的自己去找吧，网上有的
这个程序之前写得比较草，自己拿去改善吧！说实话，200分太少咯；呵呵。。。。
Option Explicit

'************************************************************************************************
'* *
'* 　　　　　工具栏和菜单 *
'* *
'************************************************************************************************
Public Sub AcadStartup1()
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

'创建新的菜单
Dim newMenu As AcadPopupMenu
Set newMenu = currMenuGroup.Menus.Add("自定义菜单(&M)")

'添加一个菜单项的子菜单
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
Dim FileSubMenu As AcadPopupMenu
'添加子菜单

' 将宏指定字符串相当于 ESC ESC _open
openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN SayHi" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "姓名和学号", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN OpenAFile" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "打开模型文件", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Make3DSolid1" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "绘制3D模型1", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Make3DSolid2" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "绘制3D模型2", openMacro)

Set newMenuItem = newMenu.AddSeparator(newMenu.Count)

Set FileSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "绘制2D实体")

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkLine" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制直线(&L)", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkPolyline" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制多段线(&P)", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkCircle" & Chr(32)
Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制圆(&C)", openMacro)

openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN OpenAFile" & Chr(32)
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "&Open File...", openMacro)

'显示菜单栏上的的菜单
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)

End Sub

Public Sub SayHi()
MsgBox "姓名：×××　　学号：××××××", , "姓名和学号"
End Sub

Public Sub OpenAFile()
ThisDrawing.SendCommand "_OPEN " '这个方法有点专空子，呵呵
End Sub

Public Sub MkLine()
ThisDrawing.SendCommand "_Line "
End Sub

Public Sub MkPolyline()
ThisDrawing.SendCommand "_PLine "
End Sub

Public Sub MkCircle()
ThisDrawing.SendCommand "_CIRCLE "
End Sub

Public Sub Make3DSolid1()
Dim objBox As Acad3DSolid, objSphere As Acad3DSolid, dblCenter(2) As Double

With ThisDrawing.ModelSpace

Set objBox = .AddBox(dblCenter, 100, 100, 100)

dblCenter(1) = 50

Set objSphere = .AddSphere(dblCenter, 45)

objBox.Boolean acSubtraction, objSphere

ZoomAll

End With

End Sub

Public Sub Make3DSolid2()

End Sub

Answer 3

解放鞋鞋底很硬啊，如果不穿棉袜脚肯定要磨破皮的！！