form1.frm

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

Private Sub Form_Resize()
Form1.Left = Screen.Width - Form1.Width - 100
Form1.Top = 100
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set returnPnt = Nothing
Set acadDoc = Nothing
Set acadApp = Nothing

End Sub

Private Sub LineNam_Click()
Me.XYDif.Value = True
End Sub

Private Sub OutputExcel_Click()
 

'
    Dim ex As Object
    Dim exwbook As Object
    Dim exsheet_point As Object
    Dim exsheet_line As Object
    Dim strItem As String
    Dim strloc As Variant

    Set ex = CreateObject("Excel.Application")
    Set exwbook = ex.Workbooks().Add
    Set exsheet_point = exwbook.Worksheets("sheet1")
    Set exsheet_line = exwbook.Worksheets("sheet2")
    
    If Me.PointNam.Value = True Then
        Set exsheet_point = exwbook.Worksheets("sheet1")
        
        For i = 0 To PLVaule.ListCount - 1
            strItem = PLVaule.List(i)
            strloc = Split(strItem, ",")
            For J = 0 To UBound(strloc)
                exsheet_point.Cells(i + 1, J + 1) = strloc(J)
            Next J
        Next i
    End If
    
 
    If Me.LineNam.Value = True Then
        Set exsheet_line = exwbook.Worksheets("sheet2")
        'exsheet_line.
        For i = 0 To PLVaule.ListCount - 1
            strItem = PLVaule.List(i)
            If Trim(strItem) <> "" Then
                strloc = Split(strItem, ",")
                For J = 0 To UBound(strloc)
                    exsheet_point.Cells(i + 1, J + 1) = strloc(J)
                Next J
            End If
        Next i
    End If
 
 
    ex.Visible = True
    Set ex = Nothing
    Set exwbook = Nothing
    Set exsheet_point = Nothing
    Set exsheet_line = Nothing
 
    
End Sub
 
Private Sub PLVaule_Click()
currentValue.Text = strTxt
End Sub

Private Sub PointNam_Click()
Me.XYDif.Value = True
End Sub

Private Sub Timer1_Timer()
    Dim strItem As String
    Dim strloc As Integer

    On Error Resume Next
'    On Error GoTo Err_Point:
    If Err Then
        Err.Clear
        Exit Sub
     End If
    nNumPoint = nNumPoint + 1
DoEvents

    returnPnt = acadDoc.Utility.GetPoint
    
    strTxt = returnPnt(0) & "," & returnPnt(1)
    currentValue.Text = strTxt

       If IsEmpty(returnPnt) Then
            If Me.LineNam.Value = True Then
                If PLVaule.List(PLVaule.ListCount - 1) <> "9999.9,9999.9" Then
                nNumLine = nNumLine + 1
                Text1.Text = nNumLine
                PLVaule.AddItem (9999.9 & "," & 9999.9)
                End If
            End If
                Me.Command1.Enabled = True
                Timer1.Enabled = False
                PLVaule.ListIndex = (PLVaule.ListCount - 1)
                VMouseClick Lhnd, 171, 120
                Command1.SetFocus
                Exit Sub
       End If
       
       If Me.Combo1.Text = "leave2" Then
                'X is the same to the previous
                  If Me.xSame.Value = True Then
                  
                        If Xflg = False Then
                            Xflg = True
                            XCoordinate = Format(CDbl(returnPnt(0)) / 1000, "####.##")
                        End If
                        
                        If PreviousX = -9999.999 Then
                            XCoordinate = Format(CDbl(returnPnt(0)) / 1000, "####.##")
                            PreviousX = XCoordinate
                        End If
                        
                        If PointNam.Value = True Then
                         'nNumPoint = nNumPoint - 1
                           PLVaule.AddItem nNumPoint & "," & (XCoordinate & " ," & Format(CDbl(returnPnt(1)) / 1000, "####.##"))
                        Else
                           PLVaule.AddItem (XCoordinate & " ," & Format(CDbl(returnPnt(1)) / 1000, "####.##") & " ," & nNumLine)
                        End If
                             
                  End If
            
                  If Me.YSame.Value = True Then
                  
                         If Yflg = False Then
                            Yflg = True
                            YCoordinate = Format(CDbl(returnPnt(1)) / 1000, "####.##")
                        End If
                        
                        If PreviousY = -9999.999 Then
                            YCoordinate = Format(CDbl(returnPnt(1)) / 1000, "####.##")
                            PreviousY = YCoordinate
                        End If
                        
                        If PointNam.Value = True Then
                          PLVaule.AddItem nNumPoint & "," & (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & YCoordinate)
                        Else
                          PLVaule.AddItem (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & YCoordinate & " ," & nNumLine)
                        End If
                        
                  End If
                  
                  If Me.XYDif.Value = True Then
                    YCoordinate = PreviousY
                    XCoordinate = PreviousX
                    
                    If PointNam.Value = True Then
                         Text1.Text = nNumPoint - 1
                        PLVaule.AddItem nNumPoint - 1 & "," & (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & Format(CLng(returnPnt(1)) / 1000, "####.##"))
                    Else
                        PLVaule.AddItem (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & Format(CLng(returnPnt(1)) / 1000, "####.##") & " ," & nNumLine)
                    End If
                  End If
                  
                    strItem = PLVaule.List(PLVaule.ListCount - 1)
                    strloc = InStr(strItem, ",")
                    
                  End If
       
       If Me.Combo1.Text = "leave3" Then
                'X is the same to the previous
                  If Me.xSame.Value = True Then
                  
                        If Xflg = False Then
                            Xflg = True
                            XCoordinate = Format(CDbl(returnPnt(0)) / 1000, "####.###")
                        End If
                        
                        If PreviousX = -9999.999 Then
                            XCoordinate = Format(CDbl(returnPnt(0)) / 1000, "####.###")
                            PreviousX = XCoordinate
                        End If
                        
                        If PointNam.Value = True Then
                           PLVaule.AddItem nNumPoint & "," & (XCoordinate & " ," & Format(CDbl(returnPnt(1)) / 1000, "####.###"))
                        Else
                           PLVaule.AddItem (XCoordinate & " ," & Format(CDbl(returnPnt(1)) / 1000, "####.###") & " ," & nNumLine)
                        End If
                             
                  End If
            
                  If Me.YSame.Value = True Then
                  
                         If Yflg = False Then
                            Yflg = True
                            YCoordinate = Format(CDbl(returnPnt(1)) / 1000, "####.###")
                        End If
                        
                        If PreviousY = -9999.999 Then
                            YCoordinate = Format(CDbl(returnPnt(1)) / 1000, "####.###")
                            PreviousY = YCoordinate
                        End If
                        
                        If PointNam.Value = True Then
                          PLVaule.AddItem nNumPoint & "," & (Format(CDbl(returnPnt(0)) / 1000, "####.###") & " ," & YCoordinate)
                        Else
                          PLVaule.AddItem (Format(CDbl(returnPnt(0)) / 1000, "####.###") & " ," & YCoordinate & " ," & nNumLine)
                        End If
                        
                  End If
                  
                  If Me.XYDif.Value = True Then
                    YCoordinate = PreviousY
                    XCoordinate = PreviousX
                    
                    If PointNam.Value = True Then
                        PLVaule.AddItem nNumPoint & "," & (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & Format(CLng(returnPnt(1)) / 1000, "####.##"))
                    Else
                        PLVaule.AddItem (Format(CDbl(returnPnt(0)) / 1000, "####.##") & " ," & Format(CLng(returnPnt(1)) / 1000, "####.##") & " ," & nNumLine)
                    End If
                  End If
                  
                    strItem = PLVaule.List(PLVaule.ListCount - 1)
                    strloc = InStr(strItem, ",")
                    
            End If
       
       If Me.Combo1.Text = "" Or Me.Combo1.Text = "All" Then
       
                If Me.xSame.Value = True Then
                
                        If PreviousX = -9999.999 Then
                            XCoordinate = CDbl(returnPnt(0)) / 1000
                            PreviousX = XCoordinate
                        End If
                        
                        If PointNam.Value = True Then
                         PLVaule.AddItem nNumPoint & "," & (XCoordinate & " ," & CDbl(returnPnt(1)) / 1000)
                        Else
                          PLVaule.AddItem (XCoordinate & " ," & CDbl(returnPnt(1)) / 1000) & " ," & nNumLine
                        End If
                        
                  End If
            
                  If Me.YSame.Value = True Then
                  
                    If PreviousY = -9999.999 Then
                        YCoordinate = CDbl(returnPnt(1)) / 1000
                        PreviousY = YCoordinate
                    End If
                    
                    If PointNam.Value = True Then
                    PLVaule.AddItem nNumPoint & "," & (CDbl(returnPnt(0)) / 1000 & " ," & YCoordinate)
                    Else
                    PLVaule.AddItem (CDbl(returnPnt(0)) / 1000 & " ," & YCoordinate) & " ," & nNumLine
                    End If
                    
                    End If
                  
                  If Me.XYDif.Value = True Then
                    If PointNam.Value = True Then
                    PLVaule.AddItem nNumPoint & "," & (CDbl(returnPnt(0)) / 1000 & " ," & CLng(returnPnt(1)) / 1000)
                   Else
                    PLVaule.AddItem (CDbl(returnPnt(0)) / 1000 & " ," & CLng(returnPnt(1)) / 1000) & " ," & nNumLine
                   End If
                     
                  End If
                  strItem = PLVaule.List(PLVaule.ListCount - 1)
                  strloc = InStr(strItem, ",")
       End If

        PLVaule.ListIndex = (PLVaule.ListCount - 1)

End Sub
 
Function Check_start() As Boolean
    If Me.PointNam.Value = vbUnchecked And Me.LineNam.Value = vbUnchecked Then
        MsgBox "マ゜サ