can anyone show me some code for programming the autocad 2000 object model.
I have incliuded some sample code from a previous application that was used
with the R14 autocad. I would like to convert it to use the new object model.

Any help would be greatly appreciated.
Option Explicit

Const ADD = 1
Const EDIT = 2
Const NONE = 3

Public objAcad As AcadApplication
Public ThisDrawing As AcadDocument
Public Operation As Integer
Public dblXPoint As Double
Public dblYPoint As Double
Public dblZPoint As Double

Dim strHandle1 As String
Dim strSQLtext As String

Public Sub cmdAddRecord_Click()
'Enables adding a new record by adding a new blank record
'that the user can fill.

Dim Message As String
Dim Response As Integer
Dim dwgName As String

On Error GoTo Error_Add

Data1.Recordset.AddNew

EnableTextButtons (True)

txtInstID = " "
txtInstName = " "
txtBldgName = " "
txtBldgNumber = " "
txtGrossArea = " "
txtDwgNumber = " "
txtFlrNumber = " "

StatusBar1.SimpleText = "Apply the changes when done."

txtInstID.SetFocus
Operation = ADD

Exit Sub

Error_Add:

MsgBox Err.Description, 16, " "
Exit Sub

End Sub
Private Sub cmdCancel_Click()
Dim Message As String
Dim Response As Integer

Message = "Terminating and canceling any pending transactions..."

'confirm cancellation
Response = MsgBox(Message, vbYesNo)

If Response = vbYes Then
On Error GoTo Error_Cancel
Set ThisDrawing = Nothing
Set objAcad = Nothing
Data1.Database.Close
Data2.Database.Close
End
End If

Exit Sub

Error_Cancel:

MsgBox Err.Description, 16, " "

Exit Sub

End Sub

Private Sub cmdClearSQL_Click()
Dim strSQLtext As String

' Reset the recordset to include all the records.
strSQLtext = "Select * From INVENTRY where instname ='" & DBCombo1.Text
& "' "
strSQLtext = strSQLtext & "Order By [InstId] asc, [Building Name] asc,
[Floor Number]asc;"

txtSQL.Text = strSQLtext

Data1.RecordSource = strSQLtext
Data1.Refresh
ChangeMenuCaptions

End Sub
Private Sub ChangeMenuCaptions()
'set menu captions according to record selection
mnuInstId.Caption = "Institute ID: " & txtInstID.Text
mnuInstName.Caption = "Institute Name: " & txtInstName.Text
mnuBldName.Caption = "Building Name: " & txtBldgName.Text
mnuBldNumber.Caption = "Building Number: " & txtBldgNumber.Text
mnuFloorNumber.Caption = "Floor Number: " & txtFlrNumber.Text
mnuGross.Caption = "Gross Area: " & txtGrossArea.Text
mnuFloorPlan.Caption = "Floor Plan: " & txtDwgNumber.Text
Me.Caption = "Current Facility in use: " & DBCombo1.Text
End Sub
Private Sub cmdApply_Click()
Dim HandleString As String
Dim HandleArea As Double
'Dim Obj1 As Object
Dim Obj1 As AcadEntity

On Error Resume Next

EnableTextButtons (False)

Select Case Operation
'When a user adds a new record or removes a record,apply the changes.
Case ADD:
On Error GoTo Error_Transaction

StatusBar1.SimpleText = "Pick an AutoCAD object to associate the
record with"

' If all boxes (except handle) are filled then apply the changes
If CheckAllFilled = True Then
HandleString = GetHandle
If HandleString <> "" Then
'The handle field is not blank, assign the handle.
Set Obj1 = ThisDrawing.HandleToObject(strHandle1)
HandleArea = Obj1.Area * 0.000001

Data1.Recordset!Gross_Area = HandleArea
Data1.Recordset!Handle = HandleString
Data1.Recordset!drawing_number = objAcad.ActiveDocument.Path
Data1.UpdateRecord
Data1.Refresh

MsgBox "New record added."
StatusBar1.SimpleText = ""
Exit Sub
Else
MsgBox "Invalid selection or handle already linked"
End If
Else
MsgBox "All the boxes must be filled in!"
StatusBar1.SimpleText = ""
Exit Sub
End If

StatusBar1.SimpleText = ""
Case EDIT:
On Error GoTo Error_Transaction
Data1.Recordset.Update
'cmdClearSQL_Click
StatusBar1.SimpleText = "Updated new record successfully."
Exit Sub
Case NONE:
EnableTextButtons (False)
Exit Sub
End Select

Error_Transaction:

MsgBox Err.Description, 16, "Error: Record not updated"
Exit Sub

End Sub

Private Sub cmdDeleteRecord_Click()
Dim Response As Integer
Dim Message As String
Dim strSQLtext As String
Dim Obj1 As Object
'Dim Obj1 As AcadEntity

StatusBar1.SimpleText = "The record will be deleted immediately."

Err.Clear

On Error Resume Next

'Get the object based on the handle
Set Obj1 = ThisDrawing.HandleToObject(strHandle1)

If Err Then
Message = "No associated object in AutoCAD. Delete the record only?"
Response = MsgBox(Message, vbYesNo)
If Response = vbYes Then
Data1.Recordset.Delete
'Reselect all the records and move to first record
cmdClearSQL_Click
StatusBar1.SimpleText = ""
Exit Sub
End If
Else
Obj1.Highlight (True)
Obj1.Update
Message = "Delete the record and associated object?"
Response = MsgBox(Message, vbYesNo)

If Response = vbYes Then
strSQLtext = "Select * From INVENTRY Where Handle = '" & Trim(strHandle1)
& "'"
Data1.RecordSource = strSQLtext
Data1.Refresh

On Error GoTo Error_Transaction

'Obj1.Delete
Obj1.Erase
objAcad.Update
Data1.Recordset.Delete
'Reselect all the records
cmdClearSQL_Click

Exit Sub

Error_Transaction:

MsgBox Err.Description, 16, " "

Exit Sub
'If no record, then output a message that there is no corresponding
record.
Else
Obj1.Highlight (False)
End If
End If

End Sub

Private Sub cmdEditRecord_Click()

'Enable editing of the records
Data1.Recordset.EDIT

EnableTextButtons (True)

StatusBar1.SimpleText = "Apply the changes when done."

Operation = EDIT

End Sub

Private Sub cmdEnd_Click()

On Error Resume Next

'Free AutoCAD
Set ThisDrawing = Nothing
Set objAcad = Nothing
Data1.Database.Close
Data2.Database.Close
'close application
End

End Sub

Public Sub ToggleHighlight()
Dim objSelectionSet As AcadSelectionSet
Dim objDrawingObject As AcadEntity

'choose a selection set name that you only use as temporary storage and
'ensure that it does not currently exist
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet").Delete
Set objSelectionSet = ThisDrawing.SelectionSets.ADD("TempSSet")

'ask user to pick entities on the screen
objSelectionSet.SelectOnScreen

'change the highlight status of each entity selected
For Each objDrawingObject In objSelectionSet
objDrawingObject.Highlight True
objDrawingObject.Update
MsgBox "Notice the entity highlighted"
objDrawingObject.Highlight (False)
objDrawingObject.Update
MsgBox "Notice the entity un-highlighted"
Next

objSelectionSet.Delete

End Sub

Private Sub cmdHighlight_Click()
Dim strSQLtext As String
'Dim Obj1 As Object
Dim Obj1 As AcadEntity
Dim PatternType As Long
Dim PatternName As String
Dim bAssociativity As Boolean

PatternName = "ANSI31"
PatternType = 0
bAssociativity = False

On Error GoTo Error_Highlight

OpenDrawing
If Trim(txtHandle.Text) <> "" Then
strHandle1 = Trim(txtHandle.Text)

Set Obj1 = ThisDrawing.HandleToObject(strHandle1)

If (cmdHighlight.Caption) = "Highlight" Then 'Trim
cmdHighlight.Caption = "Dehighlight"
tbToolBar.Buttons.Item(12).ToolTipText = ("Dehighlight")
Obj1.Highlight (True)
Obj1.Update
Else
cmdHighlight.Caption = "Highlight"
tbToolBar.Buttons.Item(12).ToolTipText = ("Highlight")
Obj1.Highlight (False)
Obj1.Update
End If
Else
MsgBox " The record doesn't exist. Use New button to add the record."
cmdClearSQL_Click
End If

Exit Sub

Error_Highlight:

MsgBox Err.Description, 16, "Error: AutoCAD object is not present"

Exit Sub

End Sub

Private Sub cmdLink_Click()
Dim HandleString As String

If Trim(txtHandle.Text) <> "" Then
MsgBox "The record is already linked."
Else
EnableTextButtons (False)

Data1.Recordset.EDIT

StatusBar1.SimpleText = "Pick an AutoCAD object to associate the
record with"

If CheckAllFilled = True Then
HandleString = GetHandle

If HandleString <> "" Then
Data1.Recordset!Handle = HandleString
Data1.UpdateRecord
StatusBar1.SimpleText = "Associated the object with the record"
Exit Sub
Else
MsgBox "Invalid selection or handle already linked"
End If
Else
MsgBox "Please fill all the boxes!"
Exit Sub
End If

StatusBar1.SimpleText = ""

End If
End Sub

Private Sub cmdSearch_Click()

On Error GoTo Error_Search

' set the search criteria = to the institutions combo box
txtSQL = "Select * From INVENTRY where instname ='" & DBCombo1.Text &
"' "
txtSQL = txtSQL & "Order By [InstId] asc, [Building Name] asc, [Floor
Number]asc;"
' Guy Giroux HMCS inc add sorting order to record set

Data1.RecordSource = txtSQL
Data1.Refresh

Exit Sub

Error_Search:

MsgBox Err.Description

Exit Sub

End Sub

Private Sub StartAutoCAD()
Dim dwgName As String

On Error Resume Next

Set objAcad = GetObject(, "AutoCAD.Application")

If Err Then
Set objAcad = CreateObject("AutoCAD.Application")
Err.Clear
End If

dwgName = txtDwgNumber.Text

If objAcad.Documents.Count > 0 Then
objAcad.Documents.Close
End If

objAcad.Documents.Open dwgName, False
Set ThisDrawing = objAcad.ActiveDocument
objAcad.Visible = True

End Sub

Private Sub cmdShowRecord_Click()
'Dim sset As Object
Dim sset As AcadSelectionSet
'Dim UtilObj As Object
Dim UtilObj As AcadUtility
Dim Pnt As Variant
Dim tempPoint(0 To 2) As Double
Dim Point(0 To 2) As Double
Dim Point1
Dim bCheck As Boolean
Dim strSQLtext As String

On Error GoTo Error_Show

StatusBar1.SimpleText = "Pick a single item on AutoCAD screen"

Set UtilObj = objAcad.ActiveDocument.Utility

Pnt = UtilObj.GetPoint(, "Pick an object in the drawing: ")

tempPoint(0) = Pnt(0)
tempPoint(1) = Pnt(1)
tempPoint(2) = Pnt(2)

Point1 = UtilObj.TranslateCoordinates(tempPoint, 0, 1, 0)
Point(0) = Point1(0)
Point(1) = Point1(1)
Point(2) = Point1(2)

StatusBar1.SimpleText = ""

Set sset = objAcad.ActiveDocument.SelectionSets.ADD("ss1")

'Call sset.SelectAtPoint(Point)
sset.SelectAtPoint (Point)

If sset.Count = 1 Then
If StrComp(sset(0).ObjectName, "AcDbPolyline", 1) = 0 Then
'G.G If StrComp(sset(0).EntityName, "AcDbPolyline", 1) = 0 Then
strHandle1 = sset(0).Handle

'initialize strSQLtext to handle number
strSQLtext = "Select * From INVENTRY Where Handle = '" & Trim(strHandle1)
& "'"

Data1.RecordSource = strSQLtext
Data1.Refresh

bCheck = True

'check recordset for duplicate handle numbers using drawing number
Do While bCheck = True
If Trim(txtDwgNumber.Text) = Trim(objAcad.ActiveDocument.Path)
Then
bCheck = False
Else
If Data1.Recordset.EOF Then
bCheck = False
Else
Data1.Recordset.MoveNext
End If
End If
Loop

If Trim(txtDwgNumber.Text) = Trim(objAcad.ActiveDocument.Path)
Then
Data1.RecordSource = strSQLtext
Else
MsgBox " The record doesn't exist. Use New button to add the
record."
End If
Else
MsgBox "No Polyline in selection"
End If
Else
If sset.Count = 0 Then
MsgBox "No Polyline in selection..."
End If

If sset.Count > 1 Then
MsgBox "More than one item in selection"
End If
End If

Exit Sub

Error_Show:

MsgBox Err.Description

Exit Sub

End Sub

Private Function CheckAllFilled() As Boolean
Dim ChkStr As String

CheckAllFilled = False

ChkStr = Trim(txtInstID.Text & txtInstName.Text & _
txtBldgName.Text & txtBldgNumber.Text & _
txtFlrNumber.Text)

If (ChkStr <> "") Then
CheckAllFilled = True
End If

End Function

Private Sub cmdStart_Click()

StartAutoCAD

End Sub

Private Sub cmdUpdate_Click()
'Dim HandleArea G.G
Dim HandleArea As Double
Dim HandleString As String
Dim Obj1 As Object
'Dim Obj1 As AcadPolyline

On Error GoTo Error_update

StatusBar1.SimpleText = "Pick an AutoCAD object to associate the record
with"

' If all boxes (except handle) are filled then apply the changes
If CheckAllFilled = True Then
HandleString = GetHandle
If HandleString = Data1.Recordset!Handle Then
'The handle field is not blank, assign the handle.
Set Obj1 = ThisDrawing.HandleToObject(strHandle1)
'convert square millimiters to square meters
HandleArea = Obj1.Area * 0.000001
Data1.Recordset.EDIT
Data1.Recordset!Gross_Area = HandleArea
Data1.UpdateRecord
MsgBox "Record updated."
StatusBar1.SimpleText = ""
Else
MsgBox "Use Show Record to Synchronize Data with Object"
End If
End If

Exit Sub

Error_update:

MsgBox Err.Description, 16, _
"Error: Use Show Record to locate corresponding data."

Exit Sub

End Sub


Private Sub DBCombo1_Click(Area As Integer)
'get institution list from query using a the invisible data2 control
End Sub

Private Sub DBCombo1_Validate(Cancel As Boolean)
If DBCombo1.DataChanged Then cmdClearSQL_Click

End Sub

Private Sub Form_Load()

Screen.MousePointer = CURSOR_WAIT

frmMain.Top = 0
frmMain.Left = 0

Data1.DatabaseName = gsDatabase
Data2.DatabaseName = gsDatabase

SetWindowPos frmMain.hwnd, conHwndTopmost, 0, 0, 0, 0, FLAGS
Screen.MousePointer = CURSOR_NORMAL
Operation = NONE

End Sub

Private Function GetHandle() As String
'Dim UtilObj As Object
Dim UtilObj As AcadUtility
'Dim Pnt G.G
Dim Pnt As Variant
Dim tempPoint(0 To 2) As Double
Dim Point(0 To 2) As Double
'Dim Point1 G.G
Dim Point1 As Variant
'Dim sset As Object
Dim sset As AcadSelectionSet

On Error GoTo Error_GetHandle

'Set UtilObj = objAcad.ActiveDocument.Utility
Set UtilObj = ThisDrawing.Utility

Pnt = UtilObj.GetPoint(, "Pick an AutoCAD object to associate the record
with: ")
'UtilObj.SelectionSets.SelectOnScreen
tempPoint(0) = Pnt(0)
tempPoint(1) = Pnt(1)
tempPoint(2) = Pnt(2)

Point1 = UtilObj.TranslateCoordinates(tempPoint, 0, 1, 0)

Point(0) = Point1(0)
Point(1) = Point1(1)
Point(2) = Point1(2)

StatusBar1.SimpleText = ""

'Set sset = objAcad.ActiveDocument.SelectionSets.ADD("ss1")
Set sset = ThisDrawing.SelectionSets.ADD("ss1")

'Call sset.SelectAtPoint(Point) G.G
sset.SelectAtPoint (Point)

If sset.Count = 1 Then
If StrComp(sset(0).ObjectName, "AcDbPolyline", 1) = 0 Then
GetHandle = sset(0).Handle
Else
MsgBox "No Polyline in selection"
GetHandle = ""
End If
Else
If sset.Count = 0 Then
'frmHW.Hide
MsgBox "No Polyline in selection..."
'frmHW.Show
End If
If sset.Count > 1 Then
MsgBox "More than one item in selection"
End If
GetHandle = ""
End If

Exit Function

Error_GetHandle:

MsgBox Err.Description, 16, "Error: AutoCAD is not running"

Exit Function

End Function

Private Sub EnableTextButtons(Mode As Boolean)
txtInstID.Enabled = Mode
txtInstName.Enabled = Mode
txtBldgName.Enabled = Mode
txtBldgNumber.Enabled = Mode
'txtGrossArea.Enabled = Mode
txtFlrNumber.Enabled = Mode
txtDwgNumber.Enabled = Mode
End Sub

Private Sub mnuLocation_Click()
Dim f As New frmDataLocation

frmMain.Visible = False

f.Show vbModal

cmdClearSQL_Click

frmMain.Visible = True

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "CAD"
cmdStart_Click
Case "New"
cmdAddRecord_Click
Case "Clear"
cmdClearSQL_Click
Case "Cancel"
cmdCancel_Click
Case "Apply"
cmdApply_Click
Case "End"
cmdEnd_Click
Case "Show"
cmdShowRecord_Click
Case "Edit"
cmdEditRecord_Click
Case "Remove"
cmdDeleteRecord_Click
Case "Link"
cmdLink_Click
Case "High"
cmdHighlight_Click
Case "Update"
cmdUpdate_Click
End Select

End Sub

Private Sub txtBldgName_Change()
ChangeMenuCaptions
End Sub

Private Sub txtDwgNumber_Change()
'txtDwgNumber.Text = Right(txtDwgNumber, 12)
ChangeMenuCaptions
End Sub

Private Sub txtHandle_Click()
MsgBox "This box cannot be edited."
End Sub

Private Sub OpenDrawing()
Dim dwgName As String
On Error Resume Next

Set objAcad = GetObject(, "AutoCAD.Application")

If Err Then
Set objAcad = CreateObject("AutoCAD.Application")
Err.Clear
End If

dwgName = txtDwgNumber.Text

If ThisDrawing.FullName <> dwgName Then
If objAcad.Documents.Count > 0 Then
objAcad.Documents.Close
End If
objAcad.Documents.Open dwgName, False
' ThisDrawing.Open dwgName
End If

Set ThisDrawing = objAcad.ActiveDocument
objAcad.Visible = True

End Sub