form1.frm

工程中人工提取图形属性非常麻烦。该程序自动将AutoCAD中的图形属性提取出来

VERSION 5.00
Object = "Excel.Sheet.8"; "EXCEL.EXE"
Begin VB.Form FrmMain 
   Caption         =   "Form1"
   ClientHeight    =   2955
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4845
   LinkTopic       =   "Form1"
   ScaleHeight     =   2955
   ScaleWidth      =   4845
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   615
      Left            =   3240
      TabIndex        =   9
      Top             =   1320
      Width           =   975
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   615
      Left            =   3240
      TabIndex        =   8
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   3240
      TabIndex        =   7
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "车位"
      Height          =   495
      Left            =   840
      TabIndex        =   6
      Top             =   240
      Width           =   2415
   End
   Begin VB.CommandButton Cmd_toCmplt 
      Caption         =   "输入到固定模板"
      Height          =   615
      Left            =   840
      TabIndex        =   4
      Top             =   1920
      Width           =   2415
   End
   Begin VB.CommandButton Cmd_SelectPntAndPntNm 
      Caption         =   "选择点号、点"
      Height          =   615
      Left            =   1920
      TabIndex        =   3
      Top             =   1320
      Width           =   1335
   End
   Begin VB.CommandButton Cmd_SelectName 
      Caption         =   "选择点号"
      Height          =   615
      Left            =   840
      TabIndex        =   2
      Top             =   720
      Width           =   1095
   End
   Begin VB.CommandButton Cmd_SelectCord 
      Caption         =   "选择坐标值"
      Height          =   615
      Left            =   1920
      TabIndex        =   1
      Top             =   720
      Width           =   1335
   End
   Begin VB.CommandButton Cmd_SelectPoint 
      Caption         =   "选择点"
      Height          =   615
      Left            =   840
      TabIndex        =   0
      Top             =   1320
      Width           =   1095
   End
   Begin ExcelCtl.Sheet Sheet1 
      Height          =   600
      Left            =   3960
      OleObjectBlob   =   "Form1.frx":0000
      TabIndex        =   5
      Top             =   1680
      Visible         =   0   'False
      Width           =   1110
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Dim ErrorBlag As Integer
Dim ErrorBlag1 As Integer
Dim ErrorBlag2 As Integer
Dim ErrorBlag3 As Integer
Dim ErrorBlag4 As Integer
Dim ErrorBlag5 As Integer


Private Sub Cmd_SelectCord_Click()
ErrorBlag2 = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag2 <> 1
Call Get_String
Call NameToExcel(PntNm)
Loop
Exit Sub
 
ErrorHandle:
ErrorBlag2 = 1
FrmMain.Show
Exit Sub
End Sub


Private Sub Cmd_SelectName_Click()
ErrorBlag1 = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag1 <> 1
Call Get_String
Call NameToExcel(PntNm)
Loop
Exit Sub
 
ErrorHandle:
ErrorBlag1 = 1
FrmMain.Show
Exit Sub
End Sub


Private Sub Cmd_SelectPntAndPntNm_Click()
ErrorBlag3 = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag3 <> 1
Call Get_String
Call Get_Point
Call PointAndNameToExcel(PntNm, P(0), P(1))

Loop
Exit Sub
 
ErrorHandle:
ErrorBlag3 = 1
FrmMain.Show
Exit Sub



End Sub

Private Sub Cmd_SelectPoint_Click()

ErrorBlag = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag <> 1
Call Get_Point
Call PointToExcel(P(0), P(1))
Loop
Exit Sub
 
ErrorHandle:
ErrorBlag = 1
FrmMain.Show
Exit Sub
 
End Sub

Private Sub Command1_Click()
ErrorBlag5 = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag <> 1

Call Get_NmandArea
Call StringsToTemplate(Nm, Area)

Loop

Exit Sub
 
ErrorHandle:
ErrorBlag5 = 1
FrmMain.Show
Exit Sub


End Sub

Private Sub Cmd_toCmplt_Click()

''格式化模板
Call Load_Template(PageCount)
PageCount = PageCount + 1

''从CAD里面取出点号及点值
ErrorBlag4 = 0
On Error GoTo ErrorHandle
FrmMain.Hide
AcadApp.Visible = True
AcadApp.WindowState = acMax

Do While ErrorBlag4 <> 1
Call Get_String
Call Get_Point
Call PointAndNameToTemplate(PntNm, P(0), P(1), H)

Loop
Exit Sub
 
ErrorHandle:
ErrorBlag4 = 1
FrmMain.Show
Exit Sub



End Sub

Private Sub Command2_Click()

Call Example_GetString
End Sub

Private Sub Command3_Click()
Call Example_PickAuto
End Sub

Private Sub Command4_Click()
Call Example_PickAdd
End Sub

Private Sub Form_Load()

PageCount = 1
Call Main

End Sub

Private Sub Form_Unload(Cancel As Integer)


'AcadDoc = Nothing
'AcadApp.Quit
'ExcelApp.Quit


End Sub