各位高手请帮忙！！

LUCKNHL

请问如何用VBA实现：在执行一个交互命令（如：获取点坐标）时，先中断，然后去执行另一个CAD的内部命令（如：缩放命令），当执行完这个命令后，再返回到中断的交互命令中继续执行。如果方便的话，请传给我一个实例代码。
我的邮件地址：LUCKNHL@163.COM

wblueboy

必须是透明命令才可以如此

bluemoon

什么是 透明命令阿 ？
能否举个例子啊？

LUCKNHL

命令可分为模式的(modeal)或透明的。一条透明命令可以在提示用户输入时调用。一条模式命令只能在command提示符下调用并且不能有其它命令或程序处于活动状态；
在绘图过程中经常要使用透明命令,Zoom、Pan、Ortho、Snap、cal(计算)、Redraw、Layer……使用时,可以在执行某个命令过程中,单击透明命令按钮(原命令不中止)或从菜单中选择其选项,也可以在命令行输入一个撇( '),再输入透明命令.

pyqzww

对不起，我想请教你一个问题！
放在模块中的宏，怎样在命令行运行！

bluemoon

bluemoon

如何才能在使用sendcommand 命令时实现模式命令与透明命令之间的转换呢？

LUCKNHL

要想在CAD命令中执行VBA编辑的宏，好象应该使用VBRUN命令。

zgyxn

是不是这样的，我这个程序在标序号是可以对较形进行缩放，拖动等透明命令
（因为有个窗口没有传上来，所以你不能进行设置）

Sub bxh()

On Error Resume Next

'*********定义变量***********
Dim textCon As String
Dim varPnt As Variant
Dim keywd As String
Dim textobj As Object
Dim Found As Boolean
Dim layerObj As AcadLayer
Dim currLayer, newlayer As AcadLayer
Static textH As Single
Static textXh As Integer
Static textPre As String
Static textSuf As String

'********选择图层***********
Found = False
For Each layerObj In ThisDrawing.Layers
If StrComp(layerObj.Name, "序号", 1) = 0 Then
   Found = True
   End If
   Next
If Not Found Then
  Set newlayer = ThisDrawing.Layers.add("序号")
  newlayer.color = acMagenta
  End If
Set newlayer = ThisDrawing.Layers("序号")

currLayer = ThisDrawing.ActiveLayer
ThisDrawing.ActiveLayer = newlayer


'*******主程序***********
bzxh:

If textH = 0 Then
  pubTexth = 1: textH = 1: PubtextPre = "(": PubtextSuf = ")"
  textSuf = ")": textPre = "("
  textXh = 1
  Else:
   PubtextPre = textPre
   PubtextSuf = textSuf
   pubTexth = textH
  End If

youForm1.TextBox4.text = pubTexth
youForm1.TextBox1.text = PubtextXh
youForm1.TextBox2.text = PubtextPre
youForm1.TextBox3.text = PubtextSuf

Err.Clear
ThisDrawing.Utility.InitializeUserInput 128, "E S"
varPnt = ThisDrawing.Utility.GetPoint(, "输入点(右键或 E 结束)/S(设置):")

'**************出错设置**************
If Err <> 0 Then
   If Err.Number = -2147352567 Then keywd = "": Err.Clear: GoTo bzxh
    Err.Clear
    keywd = ""
    ThisDrawing.Utility.InitializeUserInput 0, "E S"
    keywd = ThisDrawing.Utility.GetInput
      
    If keywd = "s" Or keywd = "S" Then '进入窗口设置
      youForm1.TextBox1.text = textXh
      youForm1.TextBox4.text = textH
      youForm1.TextBox2.text = textPre
      youForm1.TextBox3.text = textSuf
      
     
      youForm1.Show
       textH = pubTexth
       textXh = PubtextXh
       textPre = PubtextPre
       textSuf = PubtextSuf
      GoTo bzxh
      End If
      
   If keywd = "e" Or keywd = "E" Or keywd = "" Then
     GoTo en
        End If
   
   Err.Clear
   GoTo bzxh
   
  End If

'****************进行标注*************
youForm1.TextBox1.text = textXh
textCon = textPre + youForm1.TextBox1.text + textSuf
Set textobj = ThisDrawing.ModelSpace.AddText(textCon, varPnt, textH)
  textobj.Alignment = acAlignmentMiddleCenter
  textobj.TextAlignmentPoint = varPnt
  textXh = textXh + 1
GoTo bzxh
'*************end************
en:
End Sub

bluemoon