songtq 发表于 2007-8-14 14:34:00

如何在VB内嵌入Autocad的界面?

各位朋友,目前Autocad二次开发的例子通常都是需要启动Autocad,在Autocad 内部画图或实现设计功能,使用VB或Delphi开发能否将Autocad界面嵌入到VB窗口内,如果可以的话,请谈一下方法,多谢了!!

cangcang 发表于 2007-8-14 15:17:00

<p>&nbsp;Public Sub AutoCAD_Appliaction(pic As VB.PictureBox, AcadApp As AcadApplication, AcadDoc As AcadDocument) '调用AUTOCAD在VB图形窗口中<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; Dim i As Integer<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; pic.Visible = False<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; pic.Visible = True<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; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If AcadApp.Documents.Count &gt; 1 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = AcadApp.Documents.Count To 1 Step -1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set AcadDoc = AcadApp.Documents.Item(i - 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AcadDoc.Save<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AcadDoc.Close<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set AcadDoc = Nothing<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim z As AcadMenuGroup<br/>&nbsp;&nbsp;&nbsp; Dim j As AcadToolbar<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; For Each z In AcadApp.MenuGroups</p><p><br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each j In z.Toolbars<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next j<br/>&nbsp;&nbsp;&nbsp; Next z<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; lHwnd = GetParent(GetParent(AcadApp.ActiveDocument.hwnd))<br/>&nbsp;&nbsp;&nbsp; If lHwnd = 0 Then Exit Sub<br/>&nbsp;&nbsp;&nbsp; SetParent lHwnd, pic.hwnd<br/>&nbsp;&nbsp;&nbsp; SetWindowText lHwnd, "图形显示"<br/>&nbsp;&nbsp;&nbsp; AcadApp.Visible = True<br/>&nbsp;&nbsp;&nbsp; AcadApp.WindowState = acMax<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>End Sub</p><p>窗体建一图形控件</p>

songtq 发表于 2007-8-14 17:20:00

<p><strong><font face="Verdana" color="#61b713">多谢cangcang朋友给的解答,是否以后在图形中嵌入的CAD界面与使用VBA操作Autocad相同呢?还是有什么差别,或需要注意的地方,因为这方面的资料比较少,还希望能多给点建议,谢谢!</font></strong></p>

天龙八部 发表于 2007-8-14 17:22:00

把CAD嵌入VB与在CAD中使用程序区别并不大啊!唯一的好处就是不需要打开CAD,

songtq 发表于 2007-8-14 17:42:00

<p>由于本人刚学VB不久,所以刚才在VB下试了没有成功,提示“用户定义类型未定义”。</p><p>还请多多指教!!</p>

songtq 发表于 2007-8-14 19:42:00

还请各位高手指点呀!!

songtq 发表于 2007-8-14 22:25:00

<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>

mccad 发表于 2007-8-15 09:50:00

<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10991">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10991</a>

songtq 发表于 2007-8-15 11:19:00

我试着在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


songtq 发表于 2007-8-15 11:23:00

<p>C:\Documents and Settings\Owner\My Documents\My Pictures\err.bmp</p><p>不知怎样发图片,刚才发的错误图片未显示出来,在发一遍。</p>
页: [1] 2
查看完整版本: 如何在VB内嵌入Autocad的界面?