觉得Excel提供的窗体太单一？让你能制作任何样式的用户窗体！

浪子山人 · 发表于 2009-7-31 16:38

谢谢，受益匪浅

SOUSUO · 发表于 2010-1-6 11:18

俺使用过之后，忍不住再来顶一下。真是不错，好！！

xshen · 发表于 2010-2-20 17:08

谢谢分享了

yyw9230 · 发表于 2010-2-20 17:43

强大啊！这样就可以作出漂亮的工具了！

JLF2003 · 发表于 2010-2-20 22:53

谢谢楼主分享！

冲天妖狐 · 发表于 2010-2-20 23:39

非常方便调用，太妙了……

EH2003 · 发表于 2010-2-21 10:29

很多很全，拿走了。谢谢分享！

ningyong58 · 发表于 2010-3-29 16:48

Dim AcadApp As AutoCAD.AcadApplication
  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

  'Private AcadApp As Object
  Private lHwnd As Long '保存ACAD应用程序的窗口句柄
  Private lState As Long '保存ACAD的初始窗口状态
  Private r As RECT '保存ACAD的初始窗口位置
Function AcadApi()
  On Error Resume Next
  Set AcadApp = GetObject(, "AutoCAD.Application.16")
  If Err Then
Err.Clear
Set AcadApp = CreateObject("AutoCAD.Application.16")
  End If


   AcadApp.Visible = True
   Dim objEntity As Object
   Dim DwgName As String
   DwgName = App.Path & "\容积换热器2008-1-23\08RH01-00.dwg"

   Set objEntity = AcadApp.Documents.Open(DwgName)
   lHwnd = GetParent(GetParent(AcadApp.ActiveDocument.hwnd))
   If lHwnd = 0 Then Exit Function
   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
   SetWindowPos lHwnd, 0, Form1.ScaleLeft, Form1.ScaleTop, Form1.ScaleWidth * 2.7, Form1.ScaleHeight * 2.8, 0

   Exit Function


ErrTrap:
   On Error GoTo 0

End Function

AcadApi.rar (1.04 KB, 下载次数: 177)

dgxsdr · 发表于 2010-3-29 21:10

好东西，但代码看不懂！

kevinchengcw · 发表于 2010-3-29 21:54

谢谢楼主分享,这个很有用的

		自动登录	找回密码
密码			免费注册

[原创] 觉得Excel提供的窗体太单一？让你能制作任何样式的用户窗体！