编程申请，跪求高手帮忙！

furuiyong

各位前辈我想在CAD中添加宏，功能大体如下：鼠标选取圆心点，手动输入直径r ，在圆心右侧2r距离处，画线段长度2r；线段上部是编号高度r，定义循环i，自动赋值；下部是深度，手动输入；编号i自动保存到excel  A列，深度自动保存到B列。

 

 

各位前辈帮忙了，lisp也行

furuiyong

我现在还不能统计到excel中去，望前辈帮帮忙。

Public Sub OpenExcel()
      On Error Resume Next
      Set XApp = GetObject(, "Excel.Application")
   If Err Then
      Err.Clear
      Set XApp = CreateObject("Excel.Application")
      If Err Then
         Err.Clear
         MsgBox "无法启动Excel!"
         Exit Sub
      End If
   End If
   XApp.Visible = True

   On Error GoTo ErrTrap
   Set XBook = XApp.Workbooks.Add
   Set XSheet = XBook.Worksheets.Add
   XSheet.Move , XBook.Worksheets(XBook.Worksheets.Count)
ErrTrap:
    End Sub
Sub lianxi()
  Dim p As Variant, r As Double, t1(2) As Double, t2(2) As Double
  r = ThisDrawing.Utility.GetReal("输入半径:") '用户输入半径
  Call OpenExcel
   On Error GoTo Err_Control
Do
  For i = 1 To 1000
p = ThisDrawing.Utility.GetPoint(, "捕捉圆心点:") '获取点坐标
p(2) = 0
Call ThisDrawing.ModelSpace.AddCircle(p, r)
t1(0) = p(0) + 2 * r
t1(1) = p(1)
t1(2) = p(2)
t2(0) = t1(0) + 3 * r
t2(1) = t1(1)
t2(2) = t1(2)
Call ThisDrawing.ModelSpace.AddLine(t1, t2)
 Dim textshang As AcadText, textString As String, insertionPoint(0 To 2) As Double, height As Double
 Dim textxia As AcadText
             ' 创建 Text 对象
    textString = i
    insertionPoint(0) = p(0) + 3 * r
    insertionPoint(1) = p(1) + 0.4 * r
    insertionPoint(2) = t1(2)
    height = 1.5 * r
    Set textshang = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
    textshang.Update
    textString = InputBox("请输入钻孔深度", "钻孔深度", 12#)
    insertionPoint(0) = p(0) + 2.8 * r
    insertionPoint(1) = p(1) - 1.8 * r
    insertionPoint(2) = t1(2)
    height = 1.5 * r
    Set textxia = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
    textxia.Update
  Next i
Loop
Err_Control:
  ZoomAll
  End Sub

还有最好能叫cad窗口始终在上

furuiyong

就没有人帮忙吗？