houlinbo 发表于 2006-5-13 17:25:00

在VB中写CAD二次开发程序，困难 大呀，谁能帮忙解决这个问题

<P>Private Sub Command1_Click()</P>
<P><BR>Dim Pt1(0 To 2) As Double<BR>Dim Pt2(0 To 2) As Double</P>

<P>On Error Resume Next<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' 连接至 AutoCAD 应用程序<BR>&nbsp;&nbsp;&nbsp; Dim acadApp As AcadApplication<BR>&nbsp;&nbsp;&nbsp; Set acadApp = GetObject(, "AutoCAD.Application.16")<BR>&nbsp;&nbsp;&nbsp; If Err Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set acadApp = CreateObject("AutoCAD.Application.16")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox Err.Description<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' 连接至 AutoCAD 图形<BR>&nbsp;&nbsp;&nbsp; Dim acadDoc As AcadDocument<BR>&nbsp;&nbsp;&nbsp; Set acadDoc = acadApp.ActiveDocument<BR>Dim ptpick5 As Variant<BR>Dim ptpick6 As Variant<BR>&nbsp;&nbsp;&nbsp; ptpick5 = acadDoc.ModelSpace.Utility.GetPoint(, "请拾取第一点吊点位置：")<BR>&nbsp;&nbsp;&nbsp; ptpick6 = acadDoc.ModelSpace.Utility.GetPoint(, "请拾取第二点吊点位置：")<BR>&nbsp;&nbsp;&nbsp; Pt1(0) = ptpick5(0)<BR>&nbsp;&nbsp;&nbsp; Pt1(1) = ptpick5(1)<BR>&nbsp;&nbsp;&nbsp; Pt1(2) = 0<BR>&nbsp;&nbsp;&nbsp; Pt2(0) = ptpick6(0)<BR>&nbsp;&nbsp;&nbsp; Pt2(1) = ptpick6(1)<BR>&nbsp;&nbsp;&nbsp; Pt2(2) = 0<BR>Set plineobj = acadDoc.ModelSpace.AddLine(Pt1, Pt2)<BR>ZoomAll<BR>&nbsp;acadApp.Visible = True<BR>End Sub</P>



<P>以上代吗&nbsp;&nbsp; 不能和CAD进行交互，在VBA中可以，谁能帮忙在VB中实现同样的功能？谢谢</P>
页: [1]
查看完整版本: 在VB中写CAD二次开发程序，困难 大呀，谁能帮忙解决这个问题