明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1371|回复: 0

求助!cad嵌入vb问题!

[复制链接]
发表于 2005-10-21 22:18:00 | 显示全部楼层 |阅读模式

求助!我看了伊凡版主以前的一个帖子,是关于怎样把cad窗体嵌入vb程序中,我也照着做了一个,实现了嵌入,并且cad窗体能随着vb窗体的拖动改变大小。但是问题是嵌入后无法用vb控制cad画图,不知道问题在哪,希望高手帮帮忙,十分感谢!

这是关于上面问题的一个程序段,是想在嵌入后画条直线,但是不行:

Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public acadApp As Object            'The AutoCAD application object
Public acadDoc As Object            'The AutoCAD document (drawing) object
Public moSpace As Object            'The model space object collection
Public paSpace As Object            'The paper space object collection
Public AppLayer As Object           '应用程序使用的层
Public acadDocname As String
Private acadApp As Object
Private lHwnd As Long '保存ACAD应用程序的窗口句柄
Private lState As Long '保存ACAD的初始窗口状态
Private r As RECT '保存ACAD的初始窗口位置

Private Sub Form_Load()
    On Error GoTo ErrTrap
    Set acadApp = GetObject(, "AutoCAD.Application")
    acadApp.Visible = True
    lHwnd = GetParent(GetParent(acadApp.Activedocument.hwnd))
    If lHwnd = 0 Then Exit Sub
    lState = acadApp.WindowState
    acadApp.WindowState = 1 '设置ACAD的窗口状态为默认,用于保存窗口位置。
    GetWindowRect lHwnd, r
    SetParent lHwnd, Form1.hwnd
    Form1.ScaleMode = vbPixels '将VB窗体默认的缇单位改为以像素为单位。
    SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth, Form1.ScaleHeight, 0
    Exit Sub
ErrTrap:
    On Error GoTo 0
End Sub

Private Sub Form_Resize()
    SetWindowPos lHwnd, 0, Form1.ScaleLeft + 100, Form1.ScaleTop, Form1.ScaleWidth - 100, Form1.ScaleHeight, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If lHwnd = 0 Then Exit Sub
    SetParent lHwnd, 0
    SetWindowPos lHwnd, 0, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, 0
    acadApp.WindowState = lState
    Set acadApp = Nothing
End Sub

Private Sub Command1_Click()
Call lin
End Sub

Private Sub lin()
Dim lineObj As Object
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    ' Define the start and end points for the line
    startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#
    endPoint(0) = 500#: endPoint(1) = 500#: endPoint(2) = 0#
    ' Create the line in model space
    Set lineObj = moSpace.AddLine(startPoint, endPoint)
acadDoc.Application.ZoomAll
End Sub

谢谢!

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 10:26 , Processed in 0.147831 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表