如何在VB内嵌入Autocad的界面?
各位朋友,目前Autocad二次开发的例子通常都是需要启动Autocad,在Autocad 内部画图或实现设计功能,使用VB或Delphi开发能否将Autocad界面嵌入到VB窗口内,如果可以的话,请谈一下方法,多谢了!! <p> Public Sub AutoCAD_Appliaction(pic As VB.PictureBox, AcadApp As AcadApplication, AcadDoc As AcadDocument) '调用AUTOCAD在VB图形窗口中<br/> On Error Resume Next<br/> Dim i As Integer<br/> Set AcadApp = GetObject(, "AutoCAD.Application.16")<br/> If Err Then<br/> Err.Clear<br/> Set AcadApp = CreateObject("AutoCAD.Application.16")<br/> If Err Then<br/> pic.Visible = False<br/> MsgBox Err.Description<br/> pic.Visible = True<br/> Exit Sub<br/> End If<br/> Else<br/> If AcadApp.Documents.Count > 1 Then<br/> For i = AcadApp.Documents.Count To 1 Step -1<br/> Set AcadDoc = AcadApp.Documents.Item(i - 1)<br/> AcadDoc.Save<br/> AcadDoc.Close<br/> Next<br/> End If<br/> End If<br/> Set AcadDoc = Nothing<br/> <br/> Dim z As AcadMenuGroup<br/> Dim j As AcadToolbar<br/> <br/> For Each z In AcadApp.MenuGroups</p><p><br/> For Each j In z.Toolbars<br/> j.Delete<br/> Next j<br/> Next z<br/> <br/> lHwnd = GetParent(GetParent(AcadApp.ActiveDocument.hwnd))<br/> If lHwnd = 0 Then Exit Sub<br/> SetParent lHwnd, pic.hwnd<br/> SetWindowText lHwnd, "图形显示"<br/> AcadApp.Visible = True<br/> AcadApp.WindowState = acMax<br/> <br/> <br/>End Sub</p><p>窗体建一图形控件</p> <p><strong><font face="Verdana" color="#61b713">多谢cangcang朋友给的解答,是否以后在图形中嵌入的CAD界面与使用VBA操作Autocad相同呢?还是有什么差别,或需要注意的地方,因为这方面的资料比较少,还希望能多给点建议,谢谢!</font></strong></p> 把CAD嵌入VB与在CAD中使用程序区别并不大啊!唯一的好处就是不需要打开CAD, <p>由于本人刚学VB不久,所以刚才在VB下试了没有成功,提示“用户定义类型未定义”。</p><p>还请多多指教!!</p> 还请各位高手指点呀!! <p>可以实现了,在前面声明WINAPI函数,</p><p>Option Explicit<br/>Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long<br/>Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long<br/>Private lHwnd As Long</p><p>在FormLoad中,调用AutoCAD_Appliaction即可,</p><p>Call AutoCAD_Appliaction(Picture1, acadapp, acadDoc)</p><p>显示出来的界面与Autocad界面及操作完全一样。</p><p>但是,Autocad可以在Picture内部拖动,并且能够关闭和最小化,如何限制CAD的这些功能呢?还请各位高手指教,先谢了!</p> <a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10991">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10991</a> 我试着在CAD中画条直线,但每次CAD都会出现一个致命错误,另外还提示在画线时定义的点不对,不知什么原因,请大家帮我分析一下,看看是哪方面的问题,多谢!!'在CAD内画条直线
Private Sub Command1_Click()
Dim LineObj1 As AcadLine
Dim point1(0 To 2) As AcadPoint, Point2(0 To 2) As AcadPoint
point1(0) = 10#: point1(1) = 1000#: point1(2) = 0#
Point2(0) = 1000#: Point2(1) = 0#: Point2(2) = 0#
' Set LineObj1 = acadapp.ActiveDocument.ModelSpace.AddLine(point1, Point2)
End Sub
'调用AUTOCAD在VB图形窗口中
Public Sub AutoCAD_Appliaction(pic As VB.PictureBox, acadapp As AcadApplication, acadDoc As AcadDocument)
On Error Resume Next
Dim i As Integer
Set acadapp = GetObject(, "AutoCAD.Application.16")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.Application.16")
If Err Then
pic.Visible = False
MsgBox Err.Description
pic.Visible = True
Exit Sub
End If
Else
If acadapp.Documents.Count > 1 Then
For i = acadapp.Documents.Count To 1 Step -1
Set acadDoc = acadapp.Documents.Item(i - 1)
acadDoc.Save
acadDoc.Close
Next
End If
End If
Set acadDoc = Nothing
Dim z As AcadMenuGroup
Dim j As AcadToolbar
For Each z In acadapp.MenuGroups
For Each j In z.Toolbars
j.Delete
Next j
Next z
lHwnd = GetParent(GetParent(acadapp.ActiveDocument.hwnd))
If lHwnd = 0 Then Exit Sub
SetParent lHwnd, pic.hwnd
SetWindowText lHwnd, "图形显示"
acadapp.Visible = True
acadapp.WindowState = acMax
End Sub
Private Sub Form_Load()
Call AutoCAD_Appliaction(Picture1, acadapp, acadDoc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
If lHwnd = 0 Then Exit Sub
SetParent lHwnd, 0
End Sub
<p>C:\Documents and Settings\Owner\My Documents\My Pictures\err.bmp</p><p>不知怎样发图片,刚才发的错误图片未显示出来,在发一遍。</p>
页:
[1]
2