求助!我看了伊凡版主以前的一个帖子,是关于怎样把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
谢谢! |