『求助』菜单怎样调用子程序（宏）？
<p> 本人刚接触CAD的VBA，现在遇到一个问题想请教各位老师：</p><p>问题：我编辑了一个程序Sub ysdmx()，和一个自己的菜单，我想通过菜单控制子程序，但是实现不了，</p><p>命令行中显示 </p><p><font color="#ff0000">命令: _ysdmx<br/>未知命令“YSDMX”。按 F1 查看帮助。</font></p><p><font color="#ff0000"></font> 菜单：</p><p></p><p></p><p>程序：</p><p>看看红色部分是不是 问题，有错误帮我指出来，还请帮忙修改一下。</p><p>菜单程序：</p><p>Option Explicit</p><p>Sub AddASubMenu()<br/> '获得当前的菜单组***********************************************************************************<br/> Dim currMenuGroup As AcadMenuGroup<br/> Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)<br/> <br/> ' 创建新菜单<br/> Dim newMenu As AcadPopupMenu<br/> Set newMenu = currMenuGroup.Menus.Add("武赤公路" & Chr(Asc("&")) & "u")<br/> <br/> '添加菜单项*****************************************************************************************<br/> Dim <font color="#ff0000">ysdmxmacro</font> As String<br/> <font color="#ff0000">ysdmxmacro</font> = Chr(vbKeyEscape) + Chr(vbKeyEscape) '相当于按下两次Esc键<br/> 'open<br/> Dim menuItemysdmx As AcadPopupMenuItem<br/> Set menuItemysdmx = newMenu.AddMenuItem(newMenu.Count + 1, Chr(Asc("&")) & "绘地面线", ysdmxmacro & <font color="#ff0000">"_ysdmx")</font><br/> <br/> newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)<br/>End Sub</p><p>模块程序</p><p><font color="#ff3300">Sub ysdmx()</font><br/>Dim layerObj As AcadLayer '注记层<br/>Set layerObj = ThisDrawing.Layers.Add("原始地面线")<br/>layerObj.color = acGreen</p><p>Dim p1 As Variant '申明端点坐标<br/>Dim p2 As Variant<br/>Dim l() As Double '声明一个动态数组<br/>Dim A As Double<br/>Dim c As Double<br/>Dim Pline As Double<br/>c = ThisDrawing.Utility.GetReal("绘地面线<1.不标注高程,2.带高程标注>:") '用户选择绘图方式</p><p>If c = 1 Then<br/>p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标<br/>ReDim l(0 To 2) '定义动态数组<br/>l(0) = p1(0)<br/>l(1) = p1(1)<br/>l(2) = 0<br/>On Error GoTo Err_Control '出错陷井<br/>Do '开始循环<br/>p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标</p><p>lub = UBound(l) '获取当前l数组中元的元素个数<br/>ReDim Preserve l(lub + 3)<br/>For i = 1 To 3<br/> l(lub + i) = p2(i - 1)<br/>Next i<br/> <br/>Set PolylineObj = ThisDrawing.ModelSpace.AddPolyline(l) '画多段线<br/>p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标<br/>PolylineObj.Layer = "原始地面线"<br/>Loop</p><p>Else</p><p>p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标<br/>H = ThisDrawing.Utility.GetReal("输入该点高程值:") '用户输入输入该点高程值<br/>A = ThisDrawing.Utility.GetReal("输入文字大小:") '用户输入输入绘图比例<br/> '高程插入文字<br/>Dim textObj As AcadText<br/>Dim textString As String<br/>Dim insertionPoint(0 To 2) As Double<br/>Dim height As Double<br/>Dim h1 As Double '声明变量h1“相对高程”<br/>' 定义 Text 对象<br/>textString = "(" & H & ")" '书写文字<br/>insertionPoint(0) = p1(0) '文字插入点X坐标<br/>insertionPoint(1) = p1(1) + 0.1<br/>insertionPoint(2) = 0<br/>height = A '文字高度<br/>' 在模型空间中创建 Text 对象<br/>Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height) '插入文字<br/>textObj.Layer = "原始地面线" '将文字归入原始地面线图层<br/>textObj.Update</p><p>ReDim l(0 To 2) '定义动态数组<br/>l(0) = p1(0)<br/>l(1) = p1(1)<br/>l(2) = z<br/>On Error GoTo Err_Control '出错陷井<br/>Do '开始循环<br/>p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标<br/>h1 = Format(H + p2(1) - p1(1), "####0.00") '高程保留两位小数<br/>H = h1<br/>textString = "(" & h1 & ")"<br/>insertionPoint(0) = p2(0)<br/>insertionPoint(1) = p2(1) + 0.2<br/>insertionPoint(2) = 0</p><p>' 在模型空间中创建 Text 对象<br/>Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)<br/>textObj.Layer = "原始地面线" '将多段线归入原始地面线图层<br/>textObj.Update</p><p>lub = UBound(l) '获取当前l数组中元的元素个数<br/>ReDim Preserve l(lub + 3)<br/>For i = 1 To 3<br/> l(lub + i) = p2(i - 1)<br/>Next i<br/> <br/> <br/>Set PolylineObj = ThisDrawing.ModelSpace.AddPolyline(l) '画多段线<br/>p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标<br/>PolylineObj.Layer = "原始地面线" '将多段线归属到原始地面线上<br/>Loop</p><p>End If<br/>Err_Control:<br/>End Sub<br/></p> <font color="#ff0000">"_ysdmx" => "-vbarun ysdmx"</font> lzh741206发表于2009-12-27 20:31:00static/image/common/back.gif\"_ysdmx\" => \"-vbarun ysdmx\"<p>经过你的指点，调试成功，非常感谢！</p>
页:
[1]