furuiyong 发表于 2010-11-26 12:36:00

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

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

furuiyong 发表于 2010-11-26 16:35:00

<p>我现在还不能统计到excel中去，望前辈帮帮忙。</p>
<p><font face="Verdana">Public Sub OpenExcel()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set XApp = GetObject(, "Excel.Application")<br/>&nbsp;&nbsp; If Err Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set XApp = CreateObject("Excel.Application")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "无法启动Excel!"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp; End If<br/>&nbsp;&nbsp; XApp.Visible = True</font></p>
<p><font face="Verdana">&nbsp;&nbsp; On Error GoTo ErrTrap<br/>&nbsp;&nbsp; Set XBook = XApp.Workbooks.Add<br/>&nbsp;&nbsp; Set XSheet = XBook.Worksheets.Add<br/>&nbsp;&nbsp; XSheet.Move , XBook.Worksheets(XBook.Worksheets.Count)<br/>ErrTrap:<br/>&nbsp;&nbsp;&nbsp; End Sub<br/>Sub lianxi()<br/>&nbsp; Dim p As Variant, r As Double, t1(2) As Double, t2(2) As Double<br/>&nbsp; r = ThisDrawing.Utility.GetReal("输入半径:") '用户输入半径<br/>&nbsp; Call OpenExcel<br/>&nbsp;&nbsp; On Error GoTo Err_Control<br/>Do<br/>&nbsp; For i = 1 To 1000<br/>p = ThisDrawing.Utility.GetPoint(, "捕捉圆心点:") '获取点坐标<br/>p(2) = 0<br/>Call ThisDrawing.ModelSpace.AddCircle(p, r)<br/>t1(0) = p(0) + 2 * r<br/>t1(1) = p(1)<br/>t1(2) = p(2)<br/>t2(0) = t1(0) + 3 * r<br/>t2(1) = t1(1)<br/>t2(2) = t1(2)<br/>Call ThisDrawing.ModelSpace.AddLine(t1, t2)<br/>&nbsp;Dim textshang As AcadText, textString As String, insertionPoint(0 To 2) As Double, height As Double<br/>&nbsp;Dim textxia As AcadText<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' 创建 Text 对象<br/>&nbsp;&nbsp;&nbsp; textString = i<br/>&nbsp;&nbsp;&nbsp; insertionPoint(0) = p(0) + 3 * r<br/>&nbsp;&nbsp;&nbsp; insertionPoint(1) = p(1) + 0.4 * r<br/>&nbsp;&nbsp;&nbsp; insertionPoint(2) = t1(2)<br/>&nbsp;&nbsp;&nbsp; height = 1.5 * r<br/>&nbsp;&nbsp;&nbsp; Set textshang = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)<br/>&nbsp;&nbsp;&nbsp; textshang.Update<br/>&nbsp;&nbsp;&nbsp; textString = InputBox("请输入钻孔深度", "钻孔深度", 12#)<br/>&nbsp;&nbsp;&nbsp; insertionPoint(0) = p(0) + 2.8 * r<br/>&nbsp;&nbsp;&nbsp; insertionPoint(1) = p(1) - 1.8 * r<br/>&nbsp;&nbsp;&nbsp; insertionPoint(2) = t1(2)<br/>&nbsp;&nbsp;&nbsp; height = 1.5 * r<br/>&nbsp;&nbsp;&nbsp; Set textxia = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)<br/>&nbsp;&nbsp;&nbsp; textxia.Update<br/>&nbsp; Next i<br/>Loop<br/>Err_Control:<br/>&nbsp; ZoomAll<br/>&nbsp; End Sub<br/></font></p>还有最好能叫cad窗口始终在上

furuiyong 发表于 2010-11-26 21:16:00

就没有人帮忙吗？
页: [1]
查看完整版本: 编程申请，跪求高手帮忙！