『求助』菜单怎样调用子程序（宏）？

skg123

  本人刚接触CAD的VBA，现在遇到一个问题想请教各位老师：

问题：我编辑了一个程序Sub ysdmx()，和一个自己的菜单，我想通过菜单控制子程序，但是实现不了，

命令行中显示

命令: _ysdmx
未知命令“YSDMX”。按 F1 查看帮助。

 菜单：

程序：

看看红色部分是不是 问题，有错误帮我指出来，还请帮忙修改一下。

菜单程序：

Option Explicit

Sub AddASubMenu()
    '获得当前的菜单组***********************************************************************************
    Dim currMenuGroup As AcadMenuGroup
    Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
   
    ' 创建新菜单
    Dim newMenu As AcadPopupMenu
    Set newMenu = currMenuGroup.Menus.Add("武赤公路" & Chr(Asc("&")) & "u")
   
    '添加菜单项*****************************************************************************************
    Dim ysdmxmacro As String
    ysdmxmacro = Chr(vbKeyEscape) + Chr(vbKeyEscape)     '相当于按下两次Esc键
    'open
    Dim menuItemysdmx As AcadPopupMenuItem
    Set menuItemysdmx = newMenu.AddMenuItem(newMenu.Count + 1, Chr(Asc("&")) & "绘地面线", ysdmxmacro & "_ysdmx")
 
      newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

模块程序

Sub ysdmx()
Dim layerObj As AcadLayer '注记层
Set layerObj = ThisDrawing.Layers.Add("原始地面线")
layerObj.color = acGreen

Dim p1 As Variant '申明端点坐标
Dim p2 As Variant
Dim l() As Double '声明一个动态数组
Dim A As Double
Dim c As Double
Dim Pline As Double
c = ThisDrawing.Utility.GetReal("绘地面线<1.不标注高程,2.带高程标注>:") '用户选择绘图方式

If c = 1 Then
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
ReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
l(1) = p1(1)
l(2) = 0
On Error GoTo Err_Control '出错陷井
Do '开始循环
p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标

lub = UBound(l) '获取当前l数组中元的元素个数
ReDim Preserve l(lub + 3)
For i = 1 To 3
    l(lub + i) = p2(i - 1)
Next i
 
Set PolylineObj = ThisDrawing.ModelSpace.AddPolyline(l) '画多段线
p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
PolylineObj.Layer = "原始地面线"
Loop

Else

p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
H = ThisDrawing.Utility.GetReal("输入该点高程值:") '用户输入输入该点高程值
A = ThisDrawing.Utility.GetReal("输入文字大小:") '用户输入输入绘图比例
 '高程插入文字
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
Dim h1 As Double '声明变量h1“相对高程”
' 定义 Text 对象
textString = "(" & H & ")" '书写文字
insertionPoint(0) = p1(0) '文字插入点X坐标
insertionPoint(1) = p1(1) + 0.1
insertionPoint(2) = 0
height = A '文字高度
' 在模型空间中创建 Text 对象
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height) '插入文字
textObj.Layer = "原始地面线" '将文字归入原始地面线图层
textObj.Update

ReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
l(1) = p1(1)
l(2) = z
On Error GoTo Err_Control '出错陷井
Do '开始循环
p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
h1 = Format(H + p2(1) - p1(1), "####0.00") '高程保留两位小数
H = h1
textString = "(" & h1 & ")"
insertionPoint(0) = p2(0)
insertionPoint(1) = p2(1) + 0.2
insertionPoint(2) = 0

' 在模型空间中创建 Text 对象
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
textObj.Layer = "原始地面线" '将多段线归入原始地面线图层
textObj.Update

lub = UBound(l) '获取当前l数组中元的元素个数
ReDim Preserve l(lub + 3)
For i = 1 To 3
    l(lub + i) = p2(i - 1)
Next i
 
 
Set PolylineObj = ThisDrawing.ModelSpace.AddPolyline(l)  '画多段线
p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
PolylineObj.Layer = "原始地面线" '将多段线归属到原始地面线上
Loop

End If
Err_Control:
End Sub

雪山飞狐_lzh

"_ysdmx" => "-vbarun ysdmx"

skg123

lzh741206发表于2009-12-27 20:31:00\"_ysdmx\" => \"-vbarun ysdmx\"

经过你的指点，调试成功，非常感谢！