form1.frm

电脑编程技巧与维护2000-3

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   6135
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9645
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6135
   ScaleWidth      =   9645
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text2 
      DataField       =   "坐标y"
      DataSource      =   "Data1"
      Height          =   375
      Left            =   6240
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   5400
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox Text1 
      DataField       =   "坐标x"
      DataSource      =   "Data1"
      Height          =   390
      Left            =   2880
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   5400
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton Command3 
      Caption         =   "关闭"
      Height          =   375
      Left            =   7440
      TabIndex        =   3
      Top             =   5400
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "删除图元"
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   5400
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "插入图元"
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   5400
      Width           =   1695
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "C:\开放性图库\图元库.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   1680
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "图元"
      Top             =   5760
      Visible         =   0   'False
      Width           =   5535
   End
   Begin VB.ListBox List1 
      Height          =   4380
      Left            =   480
      TabIndex        =   0
      Top             =   600
      Width           =   2415
   End
   Begin VB.Label Label1 
      Caption         =   "请选择欲插入的图元："
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   240
      Width           =   1935
   End
   Begin VB.Image Image1 
      Height          =   4815
      Left            =   3240
      Stretch         =   -1  'True
      Top             =   240
      Width           =   6135
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim acadapp As Object
Dim acaddoc As Object
Dim mospace As Object
Dim acadutil As Object

Private Sub Form_Load()
On Error Resume Next
 Set acadapp = GetObject(, "autocad.application")
     If Err Then
        Err.Clear
        Set acadapp = CreateObject("autocad.application")
     End If
        Set acaddoc = acadapp.ActiveDocument
        Set mospace = acaddoc.ModelSpace
        Set acadutil = acaddoc.Utility
   
        acadapp.Visible = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
    Data1.Recordset.MoveFirst
    Do While Not Data1.Recordset.EOF
        List1.AddItem Data1.Recordset.Fields(0)
        Data1.Recordset.MoveNext
   Loop
End Sub
Private Sub Command1_Click()
    Me.Hide
    acadapp.Visible = True
    Data1.Recordset.FindFirst "文件名 = '" & List1.Text & "'" '在数据库中找到相应记录
    Dim startpt As Variant
    Dim prompt As String
        prompt = NL & "请选则将插入到的点: "    '提示用户输入起始点
        startpt = acadutil.Getpoint(, prompt)
        Dim insert(0 To 2) As Double
        insert(0) = startpt(0) - Text1.Text  '计算相对坐标x
        insert(1) = startpt(1) - Text2.Text  '计算相对坐标y
        '插入图元
        mospace.InsertBlock insert, "c:\开放性图库\图形文件\" + List1.Text + ".dwg", 1#, 1#, 0  '将图形文件以块插入到AutoCAD
    Unload Me

End Sub

Private Sub Command2_Click()
    On Error Resume Next
    Dim i As Integer
    Dim ctai As Integer
    i = List1.ListIndex
    chtai = MsgBox("是否真的要删除选定的图块？", vbYesNo + vbDefaultButton1, "注意!")
    If chtai = vbYes Then
        List1.RemoveItem (i)  '删除列表筐中的记录
        Kill "c:\开放性图库\图形文件\" + List1.Text + ".dwg"  '删除相应的dwg文件
        Kill "c:\开放性图库\图形文件\" + List1.Text + ".bmp"  '删除相应的bmp文件
       '删除数据库中的记录并使列表框选项下移
        Data1.Recordset.FindFirst "文件名 = '" & List1.Text & "'"
        Data1.Recordset.Delete
        List1.Selected(i) = True
        Call List1_Click
    Else
    End If
End Sub

Private Sub Command3_Click()
    acadapp.Visible = True
    Unload Me
End Sub



Private Sub List1_Click()
   On Error Resume Next
    Dim name As String

    name = "c:\开放性图库\图形文件\" + List1.Text + ".bmp"
    Image1.Picture = LoadPicture(name)
    
End Sub