form1.frm

捕获CAD中鼠表的位置坐标,用VS STADIO 开发

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  '屌掕(幚慄)
   Caption         =   "Catch Coordinate From CAD Directly"
   ClientHeight    =   2745
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6450
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   6450
   StartUpPosition =   2  '夋柺偺拞墰
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   3930
      TabIndex        =   16
      Text            =   "1"
      Top             =   30
      Width           =   2475
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   990
      TabIndex        =   14
      Text            =   "Combo1"
      Top             =   750
      Width           =   1335
   End
   Begin VB.TextBox currentValue 
      Height          =   285
      Left            =   3960
      TabIndex        =   13
      Top             =   2430
      Width           =   2415
   End
   Begin VB.CommandButton DeletedAll 
      Caption         =   "DeleteAll"
      Height          =   495
      Left            =   2520
      TabIndex        =   10
      Top             =   750
      Width           =   1335
   End
   Begin VB.CommandButton DeleteSelected 
      Caption         =   "DeleteSelected"
      Height          =   495
      Left            =   2520
      TabIndex        =   9
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton OutputExcel 
      Caption         =   "OutputExcel"
      Height          =   495
      Left            =   2520
      TabIndex        =   7
      Top             =   2190
      Width           =   1335
   End
   Begin VB.ListBox PLVaule 
      Height          =   1680
      IMEMode         =   1  '递
      Left            =   3960
      MultiSelect     =   2  '奼挘
      TabIndex        =   6
      Top             =   660
      Width           =   2415
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   1320
      Top             =   1170
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Height          =   495
      Left            =   2520
      TabIndex        =   0
      Top             =   1620
      Width           =   1335
   End
   Begin VB.OptionButton XYDif 
      Caption         =   " Random"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1800
      Width           =   1455
   End
   Begin VB.OptionButton YSame 
      Caption         =   "Y ==previous point"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   2280
      Width           =   1815
   End
   Begin VB.OptionButton xSame 
      Caption         =   "X = previous point"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   2040
      Width           =   1785
   End
   Begin VB.Frame Frame1 
      Caption         =   "Current Objects"
      Height          =   1185
      Left            =   0
      TabIndex        =   4
      Top             =   60
      Width           =   2415
      Begin VB.OptionButton LineNam 
         Caption         =   "Line"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   600
         Width           =   735
      End
      Begin VB.OptionButton PointNam 
         Caption         =   "Point"
         Height          =   375
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "Digital Bit"
         Height          =   255
         Left            =   960
         TabIndex        =   15
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "How to get coordinate"
      Height          =   1185
      Left            =   0
      TabIndex        =   5
      Top             =   1560
      Width           =   2415
   End
   Begin VB.Label Label1 
      Caption         =   "x: coordinate  ::  y: coordinate"
      Height          =   255
      Left            =   3990
      TabIndex        =   8
      Top             =   420
      Width           =   2355
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim acadDoc As AcadDocument
Dim EndMouseCoordinate As Integer
Dim icount As Integer
Dim acadApp As AcadApplication
'==============================
Dim MousePosition As POINTAPI
Dim ReturnValue As Long
Dim HwndHoverWindow As Long
Dim XCoordinate As String
Dim YCoordinate As String
Dim Xflg As Boolean
Dim Yflg As Boolean
Dim nNumPoint As Integer
Dim nNumLine As Integer
Dim strTxt As String
Dim Lhnd As Long
Dim PreviousX As Double
Dim PreviousY As Double


Private Sub Combo1_Click()
    Xflg = False
    Yflg = False
End Sub

'==============================
 
Private Sub Command1_Click()
Dim hCaD As Long
On Error Resume Next

    Lhnd = FindWindow(vbNullString, "Catch Coordinate From CAD Directly")
    SetWindowPos Lhnd, -1, 0, 0, 0, 0, 3
    

    hCaD = FindWindow(vbNullString, "AutoCAD 2002")
    If hCaD = 0 Then
         MsgBox "AutoCAD 2002 Application not Found or Title is not AutoCAD 2002", vbCritical
        Exit Sub
    End If
    SetForegroundWindow (hCaD)
    SetActiveWindow (hCaD)
    nNumPoint = Text1.Text
    nNumLine = Text1.Text
    strTxt = ""
    If Me.Check_start = False Then
       Exit Sub
    End If
    
    Me.Command1.Enabled = False
    ' Connect to the AutoCAD application
    'Dim acadApp As AcadApplication
    Set acadApp = GetObject _
                  (, "AutoCAD.Application")
    If Err Then
        Err.Clear
        Set acadApp = CreateObject _
                  ("AutoCAD.Application")
        If Err Then
            MsgBox Err.Description
            Exit Sub
        End If
    End If
    
    Set acadDoc = acadApp.ActiveDocument
      Timer1.Enabled = True
    EndMouseCoordinate = -1
    
    icount = 0
     PreviousX = -9999.999
     PreviousY = -9999.999
End Sub
 


'@Used:delete all the  Coordinates
'@Date:20050414
'@author:liuhp
Private Sub DeletedAll_Click()
PLVaule.Clear
End Sub
 
'@Used:delete the selected Coordinate
'@Date:20050414
'@author:liuhp
Private Sub DeleteSelected_Click()
Dim i As Integer
If PLVaule.SelCount = 0 Then
  MsgBox "No item in the listBox"
  Exit Sub
End If
'MsgBox PLVaule.ListIndex
PLVaule.RemoveItem PLVaule.ListIndex
For i = 1 To PLVaule.SelCount
    If PLVaule.Selected(PLVaule.ListIndex) Then
        PLVaule.RemoveItem PLVaule.ListIndex
    End If
Next
End Sub
 
Private Sub Form_Load()
EndMouseCoordinate = -1
nNumLine = 1
Timer1.Enabled = False
Me.PointNam.Value = vbChecked
Me.XYDif.Value = True
Me.Combo1.AddItem ("leave2")
Me.Combo1.AddItem ("leave3")
Me.Combo1.AddItem ("All")
Me.Combo1.ListIndex = 0
Xflg = False
Yflg = False
PreviousX = -9999.999
PreviousY = -9999.999
'----------------------
'For i = 1 To 5
'PLVaule.AddItem ("33898.8484::84848.37383")
'Next i
'----------------------
End Sub