Method 'AttachTo' of object 'ODRecord' failed

Method 'AttachTo' of object 'ODRecord' failed

Anonymous
Not applicable
817 Views
10 Replies
Message 1 of 11

Method 'AttachTo' of object 'ODRecord' failed

Anonymous
Not applicable
Programming in AutoCAD 2000, I attempted to insert a calculated value to the
current entity/object in the [slope] field of a "SEWER" table but the
following error message popped up: Run-time error '-2147352567(80020009)':
Method 'AttachTo' of object 'ODRecord' failed. A sample portion of the code
is as follows:

...Dim Tables As ODTables
Dim Table As ODTable
Dim Orecords As ODRecords
Dim Orecord As ODRecord
Dim ent As AcadEntity
Dim ObjectID As Long
Dim z As Double, z_fr As Double, z_to As Double
Dim Lngth As Double
Dim SlpFt As Variant...

...Set Tables = amobj.ODTables
Set Orecords = Tables.GetODRecords...

...For Each ent in ThisDrawing.ModelSpace...
..Lngth = ent.Length...

Orecords.Init ent, False, False
If Orecords.IsDone Then
msg = ""
Else
Set Orecord = Orecords.Record
End If
Set Table = amobj.ODTables.Item(Orecord.tableName)
z_fr = Orecord.Item(7).Value
z_to = Orecord.Item(8).Value
z = z_fr - z_to
SlpFt = z / Lngth
Orecord.Item(19).Value = SlpFt
Orecord.AttachTo (ent.ObjectID)...

The correct calculated value for SlpFt and correct value for ent.ObjectID
are present/can be displayed when the program is interrupted due to the
above error message. Can anyone give me some insight as to what I am doing
wrong to input the SlpFt value into the record for item 'Slope' in the table
or why there is an error associated with this method? Thanks!!
0 Likes
818 Views
10 Replies
Replies (10)
Message 2 of 11

Anonymous
Not applicable
I think your code is assuming that there is already a table attached to the
object. If so, then where you have 'Orecord.AttachTo(ent.ObjectID)' try
'Orecords.Update Orecord' but this requires that you change 'Orecords.Init
ent, False, False' to 'Orecords.Init ent, True, False' in order enable
updating of the table records.


Eric Smallwood

"Gregg Greer" wrote in message
news:6022F0D515D18429CCBF8D483ABD56E9@in.WebX.maYIadrTaRb...
> Programming in AutoCAD 2000, I attempted to insert a calculated value to
the
> current entity/object in the [slope] field of a "SEWER" table but the
> following error message popped up: Run-time error '-2147352567(80020009)':
> Method 'AttachTo' of object 'ODRecord' failed. A sample portion of the
code
> is as follows:
>
> ...Dim Tables As ODTables
> Dim Table As ODTable
> Dim Orecords As ODRecords
> Dim Orecord As ODRecord
> Dim ent As AcadEntity
> Dim ObjectID As Long
> Dim z As Double, z_fr As Double, z_to As Double
> Dim Lngth As Double
> Dim SlpFt As Variant...
>
> ...Set Tables = amobj.ODTables
> Set Orecords = Tables.GetODRecords...
>
> ...For Each ent in ThisDrawing.ModelSpace...
> ..Lngth = ent.Length...
>
> Orecords.Init ent, False, False
> If Orecords.IsDone Then
> msg = ""
> Else
> Set Orecord = Orecords.Record
> End If
> Set Table = amobj.ODTables.Item(Orecord.tableName)
> z_fr = Orecord.Item(7).Value
> z_to = Orecord.Item(8).Value
> z = z_fr - z_to
> SlpFt = z / Lngth
> Orecord.Item(19).Value = SlpFt
> Orecord.AttachTo (ent.ObjectID)...
>
> The correct calculated value for SlpFt and correct value for ent.ObjectID
> are present/can be displayed when the program is interrupted due to the
> above error message. Can anyone give me some insight as to what I am
doing
> wrong to input the SlpFt value into the record for item 'Slope' in the
table
> or why there is an error associated with this method? Thanks!!
>
>
0 Likes
Message 3 of 11

Anonymous
Not applicable
Thanks for your help Eric. Yes, a "SEWER" table is already attached to
the object. I have revised the code as instructed and had to add an
additional 'Orecords.Init ent, True, False' within the select case "C-SW"
structure since setting the first Orecords.Init ent, to true and false
caused the error message 'Run-time error '-2145386417(8020004f)': Object was
open for write' and the program stopped at the 'p1 = ent.StartPoint' line.
Inserting the line of code 'Orecords.Update Orecord' in place of the
original coding causes the same run-time error as before (Method 'Update' of
object 'ODRecords' failed) only with the Update method replacing the
AttachTo method. Also, utilizing the line of code 'Orecords.Update Orecord'
causes some funky things to occur with the values z1, z2 assigned as 0
instead of the correct assigned elevation values as present in the record
for these items. So, changing the last line to 'Orecords.Update
Orecord.Item(19).Value' to try and force the SlpFt value (not an object, I
know) into this record and table now results in the error message 'Run-time
error '424': Object required', but at least the correct assigned/passed and
calculated values for z1, z2, z, and SlpFt have returned to what they should
be. Are there any other suggestions/methods to try in order to assign the
SlpFt calculated value into each empty record per field item 19 (SLOPE)?? Is
this task really this difficult or is it just me?! All help/suggestions is
greatly appreciated!!!

Below is the revised code:

...Dim Tables As ODTables
Dim Table As ODTable
Dim Orecords As ODRecords
Dim Orecord As ODRecord
Dim ent As AcadEntity
Dim ObjectID As Long
Dim p1 As Variant, p2 As Variant
Dim z As Double, z_fr As Double, z_to As Double
Dim Lngth As Double
Dim SlpFt As Variant...

Set Table = amobj.ODTables.Item("SEWER")
Set Orecords = Table.GetODRecords

For Each ent in ThisDrawing.ModelSpace
Select Case ent.EntityType...
entLayer = ent.Layer
Lngth = ent.Length...

Orecords.Init ent, False, False
If Orecords.IsDone Then
msg = ""
Else
Set Orecord = Orecords.Record
End If

Select Case entLayer
Case "C-SW" 'Layer name for sewer pipe entities
p1 = ent.StartPoint
p2 = ent.EndPoint

Set Table = amobj.ODTables.Item(Orecord.tableName)
Orecords.Init ent, True, False...

z_fr = Orecord.Item(7).Value
z_to = Orecord.Item(8).Value...
z = z_fr - z_to
SlpFt = z / Lngth
Orecord.Item(19).Value = SlpFt
Orecords.Update Orecord.Item(19).Value...

"Eric Smallwood" wrote in message
news:AC8E81DBBFD9FF94A0BCFBE2E10D100E@in.WebX.maYIadrTaRb...
> I think your code is assuming that there is already a table attached to
the
> object. If so, then where you have 'Orecord.AttachTo(ent.ObjectID)' try
> 'Orecords.Update Orecord' but this requires that you change 'Orecords.Init
> ent, False, False' to 'Orecords.Init ent, True, False' in order enable
> updating of the table records.
>
>
> Eric Smallwood
>
> "Gregg Greer" wrote in message
> news:6022F0D515D18429CCBF8D483ABD56E9@in.WebX.maYIadrTaRb...
> > Programming in AutoCAD 2000, I attempted to insert a calculated value to
> the
> > current entity/object in the [slope] field of a "SEWER" table but the
> > following error message popped up: Run-time error
'-2147352567(80020009)':
> > Method 'AttachTo' of object 'ODRecord' failed. A sample portion of the
> code
> > is as follows:
> >
> > ...Dim Tables As ODTables
> > Dim Table As ODTable
> > Dim Orecords As ODRecords
> > Dim Orecord As ODRecord
> > Dim ent As AcadEntity
> > Dim ObjectID As Long
> > Dim z As Double, z_fr As Double, z_to As Double
> > Dim Lngth As Double
> > Dim SlpFt As Variant...
> >
> > ...Set Tables = amobj.ODTables
> > Set Orecords = Tables.GetODRecords...
> >
> > ...For Each ent in ThisDrawing.ModelSpace...
> > ..Lngth = ent.Length...
> >
> > Orecords.Init ent, False, False
> > If Orecords.IsDone Then
> > msg = ""
> > Else
> > Set Orecord = Orecords.Record
> > End If
> > Set Table = amobj.ODTables.Item(Orecord.tableName)
> > z_fr = Orecord.Item(7).Value
> > z_to = Orecord.Item(8).Value
> > z = z_fr - z_to
> > SlpFt = z / Lngth
> > Orecord.Item(19).Value = SlpFt
> > Orecord.AttachTo (ent.ObjectID)...
> >
> > The correct calculated value for SlpFt and correct value for
ent.ObjectID
> > are present/can be displayed when the program is interrupted due to the
> > above error message. Can anyone give me some insight as to what I am
> doing
> > wrong to input the SlpFt value into the record for item 'Slope' in the
> table
> > or why there is an error associated with this method? Thanks!!
> >
> >
>
>
0 Likes
Message 4 of 11

Anonymous
Not applicable
I think the problem may be that one or more of your sewer lines doesn't have
an object data table. I extracted a section of code I have for updating an
object data table, modified it a little to do what I think you're looking
for, and then I tested it out on a set of lines with an object data table I
called "SewerTable." The test routine worked fine, it extracts two numbers
from the table, subtracts them and then divides by the length of the line,
and then puts the number into the table. However, when I detached a table
from one of the lines and ran the routine again, then I received an error
message. It was trying to read a record from an absent table.

So you might check to see if all your lines have tables, or put a condition
in the routine to pass over lines without tables. I attached the test
routine I was working on.


Eric Smallwood
0 Likes
Message 5 of 11

Anonymous
Not applicable
Now that I take another look at your code, I think the problem is that the
'If Orecords.IsDone Then' check doesn't bypass the remaining code, meaning
that if an object doesn't have a table, it's stil going to head for the code
that is looking to update the table, and that's where the error message
occurs. So, I think you need to move the 'End if' to the bottom of the code
but before the Next.


Eric Smallwood

"Gregg Greer" wrote in message
news:322DC5D5B0B5846310CB06BD764E2BDF@in.WebX.maYIadrTaRb...
> Thanks for your help Eric. Yes, a "SEWER" table is already attached to
> the object. I have revised the code as instructed and had to add an
> additional 'Orecords.Init ent, True, False' within the select case "C-SW"
> structure since setting the first Orecords.Init ent, to true and false
> caused the error message 'Run-time error '-2145386417(8020004f)': Object
was
> open for write' and the program stopped at the 'p1 = ent.StartPoint' line.
> Inserting the line of code 'Orecords.Update Orecord' in place of the
> original coding causes the same run-time error as before (Method 'Update'
of
> object 'ODRecords' failed) only with the Update method replacing the
> AttachTo method. Also, utilizing the line of code 'Orecords.Update
Orecord'
> causes some funky things to occur with the values z1, z2 assigned as 0
> instead of the correct assigned elevation values as present in the record
> for these items. So, changing the last line to 'Orecords.Update
> Orecord.Item(19).Value' to try and force the SlpFt value (not an object, I
> know) into this record and table now results in the error message
'Run-time
> error '424': Object required', but at least the correct assigned/passed
and
> calculated values for z1, z2, z, and SlpFt have returned to what they
should
> be. Are there any other suggestions/methods to try in order to assign the
> SlpFt calculated value into each empty record per field item 19 (SLOPE)??
Is
> this task really this difficult or is it just me?! All help/suggestions is
> greatly appreciated!!!
>
> Below is the revised code:
>
> ...Dim Tables As ODTables
> Dim Table As ODTable
> Dim Orecords As ODRecords
> Dim Orecord As ODRecord
> Dim ent As AcadEntity
> Dim ObjectID As Long
> Dim p1 As Variant, p2 As Variant
> Dim z As Double, z_fr As Double, z_to As Double
> Dim Lngth As Double
> Dim SlpFt As Variant...
>
> Set Table = amobj.ODTables.Item("SEWER")
> Set Orecords = Table.GetODRecords
>
> For Each ent in ThisDrawing.ModelSpace
> Select Case ent.EntityType...
> entLayer = ent.Layer
> Lngth = ent.Length...
>
> Orecords.Init ent, False, False
> If Orecords.IsDone Then
> msg = ""
> Else
> Set Orecord = Orecords.Record
> End If
>
> Select Case entLayer
> Case "C-SW" 'Layer name for sewer pipe entities
> p1 = ent.StartPoint
> p2 = ent.EndPoint
>
> Set Table = amobj.ODTables.Item(Orecord.tableName)
> Orecords.Init ent, True, False...
>
> z_fr = Orecord.Item(7).Value
> z_to = Orecord.Item(8).Value...
> z = z_fr - z_to
> SlpFt = z / Lngth
> Orecord.Item(19).Value = SlpFt
> Orecords.Update Orecord.Item(19).Value...
0 Likes
Message 6 of 11

Anonymous
Not applicable
Thanks again for your assistance with this Eric. However, I am now
completely stumped as to why it is not 'updating' the records for each
iteration. It should work now as I have made changes as suggested as well
as some others, but it still does not update each record that it should for
items SLOPE and ZLENGTH. The record for each of these fields remain
unchanged (default value '0.0000' respectively) when the routine finishes
and the object data records for these items for each pipe entity is checked.
There are no error messages when the program finishes. It bypasses line
entities that do not include an attached object data table and also checks
to see if a "SEWER" table exists. For purposes of checking whether the
values for each record within the invert elevations are recognized/passed
and correct calculations for the slope and 3D pipe length are assigned, I
included code to pass the extracted elevation values and calculated values
to an Excel spreadsheet for each record iteration and it works great. Any
other ideas/suggestions to make this code work for updating the records
within the object data table is appreciated . Below is the latest version
of code:

Private Sub ComGetEnt_Click()
Dim p1 As Variant, p2 As Variant
Dim x As Double, y As Double
Dim z_from As Double, z_to As Double
Dim Zlngth
Dim Lngth
Dim rise
Dim SlpFt

Dim acadApp As AcadApplication
Dim ent As AcadEntity
Dim amobj As AcadMap
Dim acadObject As Object
Dim objectID As Long
Dim proj As Project
Dim DrawSet As DrawingSet
Dim AttachedDwg As AttachedDrawing

Dim Tables As ODTables
Dim Table As ODTable
Dim Fields As ODFieldDefs
Dim Field As ODFieldDef
Dim entHandle As String
Dim entType As String
Dim entLayer As String
Dim dwgName As String
Dim Orecords As ODRecords
Dim Orecord As ODRecord
Dim Fieldval As ODFieldValue
Dim msg As String
Dim pv_temp As String
Dim pb_quit As Boolean

Dim Excel As Object
Dim excelSheet As Object
Dim RowNum As Integer

Set acadApp = ThisDrawing.Application
Set amobj = acadApp.GetInterfaceObject("AutoCADMap.Application")
Set proj = amobj.Projects(ThisDrawing)

dwgName = ThisDrawing.Name
Me.Hide

''Starts/Loads Excel
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If
On Error GoTo 0

Excel.Visible = True
Excel.Workbooks.Add
Excel.Sheets("Sheet1").Select

Excel.ActiveWorkbook.SaveAs (dwgName)

Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")

RowNum = 1
excelSheet.Cells(RowNum, 1).Value = "Mapkey"
excelSheet.Cells(RowNum, 2).Value = "3DLength"
excelSheet.Cells(RowNum, 3).Value = "Slope_FT"
excelSheet.Cells(RowNum, 4).Value = "Rise_FT"
excelSheet.Cells(RowNum, 5).Value = "2DLength"
excelSheet.Range("A1:E1").Font.Bold = True

Set Table = proj.ODTables.Item("SEWER")
If Table Is Nothing Then
MsgBox "Object Data Table does not exist"
Exit Sub
End If

For Each ent In ThisDrawing.ModelSpace
Select Case ent.EntityType
Case acLine
entHandle = ent.Handle
entLayer = ent.Layer
Lngth = ent.Length

p1 = ent.StartPoint
p2 = ent.EndPoint

Set Orecords = Table.GetODRecords

If Orecords Is Nothing Then
MsgBox "No Object Data associated"
Exit Sub
End If


Select Case entLayer
Case "C-SW"

Orecords.Init ent, True, False

If (Orecords.IsDone = False) Then
Set Orecord = Orecords.record

pcounter = pcounter + 1

z1 = Orecord.Item(6).Value
z2 = Orecord.Item(7).Value

x = p1(0) - p2(0)
y = p1(1) - p2(1)

'Calculate the 'rise' value
z = z1 - z2

'Calculate the 3D Line length
Zlngth = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))

'Calculate the slope in ft/ft
SlpFt = z / Lngth

Orecord.Item(2).Value = Zlngth
Orecord.Item(19).Value = SlpFt
Orecords.Update Orecord

''This portion of routine places extracted data into Excel worksheet

RowNum = RowNum + 1
excelSheet.Cells(RowNum, 1).Value = entHandle
excelSheet.Cells(RowNum, 2).Value = Zlngth
excelSheet.Cells(RowNum, 2).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 3).Value = SlpFt
excelSheet.Cells(RowNum, 3).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 4).Value = z
excelSheet.Cells(RowNum, 4).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 5).Value = Lngth
excelSheet.Cells(RowNum, 5).NumberFormat = "0.000000"

End If
End Select
Set Orecords = Nothing
End Select
Next

excelSheet.columns("A:G").AutoFit

If pcounter > 0 Then
MsgBox ("Found " & pcounter & " Sewer pipe entities.") '(...Data Transfer
Complete.")
End If

End Sub

"Eric Smallwood" wrote in message
news:FE3B7F1E5132C379B7BD9DDF22BDE77B@in.WebX.maYIadrTaRb...
> Now that I take another look at your code, I think the problem is that the
> 'If Orecords.IsDone Then' check doesn't bypass the remaining code, meaning
> that if an object doesn't have a table, it's stil going to head for the
code
> that is looking to update the table, and that's where the error message
> occurs. So, I think you need to move the 'End if' to the bottom of the
code
> but before the Next.
>
>
> Eric Smallwood
>
> "Gregg Greer" wrote in message
> news:322DC5D5B0B5846310CB06BD764E2BDF@in.WebX.maYIadrTaRb...
> > Thanks for your help Eric. Yes, a "SEWER" table is already attached to
> > the object. I have revised the code as instructed and had to add an
> > additional 'Orecords.Init ent, True, False' within the select case
"C-SW"
> > structure since setting the first Orecords.Init ent, to true and false
> > caused the error message 'Run-time error '-2145386417(8020004f)': Object
> was
> > open for write' and the program stopped at the 'p1 = ent.StartPoint'
line.
> > Inserting the line of code 'Orecords.Update Orecord' in place of the
> > original coding causes the same run-time error as before (Method
'Update'
> of
> > object 'ODRecords' failed) only with the Update method replacing the
> > AttachTo method. Also, utilizing the line of code 'Orecords.Update
> Orecord'
> > causes some funky things to occur with the values z1, z2 assigned as 0
> > instead of the correct assigned elevation values as present in the
record
> > for these items. So, changing the last line to 'Orecords.Update
> > Orecord.Item(19).Value' to try and force the SlpFt value (not an object,
I
> > know) into this record and table now results in the error message
> 'Run-time
> > error '424': Object required', but at least the correct assigned/passed
> and
> > calculated values for z1, z2, z, and SlpFt have returned to what they
> should
> > be. Are there any other suggestions/methods to try in order to assign
the
> > SlpFt calculated value into each empty record per field item 19
(SLOPE)??
> Is
> > this task really this difficult or is it just me?! All help/suggestions
is
> > greatly appreciated!!!
> >
> > Below is the revised code:
> >
> > ...Dim Tables As ODTables
> > Dim Table As ODTable
> > Dim Orecords As ODRecords
> > Dim Orecord As ODRecord
> > Dim ent As AcadEntity
> > Dim ObjectID As Long
> > Dim p1 As Variant, p2 As Variant
> > Dim z As Double, z_fr As Double, z_to As Double
> > Dim Lngth As Double
> > Dim SlpFt As Variant...
> >
> > Set Table = amobj.ODTables.Item("SEWER")
> > Set Orecords = Table.GetODRecords
> >
> > For Each ent in ThisDrawing.ModelSpace
> > Select Case ent.EntityType...
> > entLayer = ent.Layer
> > Lngth = ent.Length...
> >
> > Orecords.Init ent, False, False
> > If Orecords.IsDone Then
> > msg = ""
> > Else
> > Set Orecord = Orecords.Record
> > End If
> >
> > Select Case entLayer
> > Case "C-SW" 'Layer name for sewer pipe entities
> > p1 = ent.StartPoint
> > p2 = ent.EndPoint
> >
> > Set Table = amobj.ODTables.Item(Orecord.tableName)
> > Orecords.Init ent, True, False...
> >
> > z_fr = Orecord.Item(7).Value
> > z_to = Orecord.Item(8).Value...
> > z = z_fr - z_to
> > SlpFt = z / Lngth
> > Orecord.Item(19).Value = SlpFt
> > Orecords.Update Orecord.Item(19).Value...
>
>
>
0 Likes
Message 7 of 11

Anonymous
Not applicable
you'll get it 😉 First, check a little thing. With this latest code, I
noticed that there are a few minor errors that you probably have fixed. 'z'
'z1' & 'z2' aren't declared. But apart from this, I broke out the essential
section of the code (minus the Excel connect) and ran it using a test
drawing, and what I found was that when I created an object data table with
'integer' fields, the slope wasn't seen because the slope is a real not an
integer. So, check your object data table to see whether field 19 (or 18) is
an integer or a real. The code worked fine when I made this change.


Eric Smallwood
0 Likes
Message 8 of 11

Anonymous
Not applicable
Thanks Eric. Yes, the variables 'z1', 'z2', and 'z' are declared in the
program. I am about to go ballistic with this! The SLOPE & ZLENGTH fields
in the SEWER object data table are and always have been defined as 'real'
number fields. So you would think that declaring 'Zlngth As Double', and
'SlpFt As Double', etc., would work and the records within the fields woul
be updated with the assigned values per iteration. No such luck! The
program continues to defy every attempt to find a way to populate/update the
records. This has tested my patience to say the least! But I'm going to
keep at this code until it works properly even if it drives me over the edge
in the process. Any other suggestions would be most helpful because right
now I'm at a loss for other ideas.

"Eric Smallwood" wrote in message
news:B85B804CEA5418BBA6AF8D95B0A34AD0@in.WebX.maYIadrTaRb...
> you'll get it 😉 First, check a little thing. With this latest code, I
> noticed that there are a few minor errors that you probably have fixed.
'z'
> 'z1' & 'z2' aren't declared. But apart from this, I broke out the
essential
> section of the code (minus the Excel connect) and ran it using a test
> drawing, and what I found was that when I created an object data table
with
> 'integer' fields, the slope wasn't seen because the slope is a real not an
> integer. So, check your object data table to see whether field 19 (or 18)
is
> an integer or a real. The code worked fine when I made this change.
>
>
> Eric Smallwood
>
>
0 Likes
Message 9 of 11

Anonymous
Not applicable
"Gregg Greer" wrote in message
news:7C3256D897B1173A4323345AC83D4D07@in.WebX.maYIadrTaRb...
> ... The program continues to defy every attempt to find a way to
populate/update
> the records. This has tested my patience to say the least! But I'm going
to
> keep at this code until it works properly even if it drives me over the
edge
> in the process. Any other suggestions would be most helpful because right
> now I'm at a loss for other ideas.

Hello Gregg,

Okay, here's the issue. The Map 4 api
has a bug that prevents updating an
existing object data record on entities.

The workaround is to update the record
in memory, re-assign it to the entity
as a new record, and then delete the
original record.

In this example, I've already obtained
the iNth record oRec from the records
collection oRecs in the odtable oTbl on
a specific acad entity oEnt:

'' first, release the collection iterator
Set oRecs = Nothing

'' next update the odvalue in memory
oRec.Item(0).Value = "new value"

'' now attach the updated record to the entity
If oRec.AttachTo(oEnt.ObjectID) Then

'' if the new record was added, delete the old

'' get the record collection
Set oRecs = oTbl.GetODRecords
If oRecs.Init(oEnt, True, False) Then

'' move to the correct record number
For i = 0 to iNth
oRecs.Next
Next

'' finally, delete the old record
If Not oRecs.Remove Then

'' couldn't delete old record
End If

Else
'' couldn't get iterator
End If

Else
'' couldn't attach new record
End If

This code will work for both Map 4 and
all later versions (where the defect has
been fixed), and is only slightly more
work than a direct update.

Sorry for the hassle.

rdh.
0 Likes
Message 10 of 11

Anonymous
Not applicable
argh 😉

Okay, now, I took the code, created a test drawing, created some lines and
placed them on layer "C-SW", created an object data table called "Sewer"
with 20 fields (0-19), attached the table to the lines, put in some values
in for fields 6 and 7, and then ran the code from the Tools, Macro menu, and
the thing worked. The Excel file popped up and the fields were populated,
field 2 had the length and field 19 had the slope.

So, here is an exact copy of what I tried:

------
Option Explicit

Sub ComGetEnt_Click()
Dim p1 As Variant, p2 As Variant
Dim x As Double, y As Double
Dim z1 As Double, z2 As Double, z As Double
Dim Zlngth As Double, Lngth As Double, SlpFt As Double

Dim acadApp As AcadApplication
Dim ent As AcadEntity
Dim amobj As AcadMap
Dim proj As Project

Dim Table As ODTable
Dim entHandle As String
Dim entType As String
Dim entLayer As String
Dim dwgName As String
Dim Orecords As ODRecords
Dim Orecord As ODRecord

Dim Excel As Object
Dim excelSheet As Object
Dim RowNum As Integer

Set acadApp = ThisDrawing.Application
Set amobj = acadApp.GetInterfaceObject("AutoCADMap.Application")
Set proj = amobj.Projects(ThisDrawing)

Set Table = proj.ODTables.Item("SEWER")
If Table Is Nothing Then
MsgBox "Object Data Table does not exist"
Exit Sub
End If

On Error Resume Next
'Starts/Loads Excel
Set Excel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
Exit Sub
End If
End If

Excel.Visible = True
Excel.Workbooks.Add
Excel.Sheets("Sheet1").Select
'dwgName = ThisDrawing.Name
'Excel.ActiveWorkbook.SaveAs (dwgName)

Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")
RowNum = 1
excelSheet.Cells(RowNum, 1).Value = "Mapkey"
excelSheet.Cells(RowNum, 2).Value = "3DLength"
excelSheet.Cells(RowNum, 3).Value = "Slope_FT"
excelSheet.Cells(RowNum, 4).Value = "Rise_FT"
excelSheet.Cells(RowNum, 5).Value = "2DLength"
excelSheet.Range("A1:E1").Font.Bold = True

On Error GoTo Err_Control
For Each ent In ThisDrawing.ModelSpace
Select Case ent.EntityType
Case acLine
entHandle = ent.Handle
entLayer = ent.Layer
entLayer = UCase(entLayer)
Lngth = ent.Length
p1 = ent.StartPoint
p2 = ent.EndPoint

Set Orecords = Table.GetODRecords
If Orecords Is Nothing Then
MsgBox "No Object Data associated"
Exit Sub
End If

Select Case entLayer
Case "C-SW"
Orecords.Init ent, True, False
If (Orecords.IsDone = False) Then
Set Orecord = Orecords.Record
z1 = Orecord.Item(6).Value
z2 = Orecord.Item(7).Value
x = p1(0) - p2(0)
y = p1(1) - p2(1)
'Calculate the 'rise' value
z = z1 - z2
'Calculate the 3D Line length
Zlngth = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
'Calculate the slope in ft/ft
SlpFt = z / Lngth
Orecord.Item(2).Value = Zlngth
Orecord.Item(19).Value = SlpFt
Orecords.Update Orecord

'This portion of routine places extracted data into Excel
worksheet
RowNum = RowNum + 1
excelSheet.Cells(RowNum, 1).Value = entHandle
excelSheet.Cells(RowNum, 2).Value = Zlngth
excelSheet.Cells(RowNum, 2).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 3).Value = SlpFt
excelSheet.Cells(RowNum, 3).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 4).Value = z
excelSheet.Cells(RowNum, 4).NumberFormat = "0.000000"
excelSheet.Cells(RowNum, 5).Value = Lngth
excelSheet.Cells(RowNum, 5).NumberFormat = "0.000000"

End If
End Select
Set Orecords = Nothing
End Select
Next
Set Excel = Nothing
Exit Sub

Err_Control:
MsgBox Err.Description
End Sub
0 Likes
Message 11 of 11

Anonymous
Not applicable
ahhh. I was working from 4.5 and didn't encounter the bug. Well done
(hopefully ;)).


Eric Smallwood
"Richard D. Howard [Autodesk GIS]" wrote in
message news:22C58010C4D3214FB281FFB17A3AFAFC@in.WebX.maYIadrTaRb...
> "Gregg Greer" wrote in message
> news:7C3256D897B1173A4323345AC83D4D07@in.WebX.maYIadrTaRb...
> > ... The program continues to defy every attempt to find a way to
> populate/update
> > the records. This has tested my patience to say the least! But I'm
going
> to
> > keep at this code until it works properly even if it drives me over the
> edge
> > in the process. Any other suggestions would be most helpful because
right
> > now I'm at a loss for other ideas.
>
> Hello Gregg,
>
> Okay, here's the issue. The Map 4 api
> has a bug that prevents updating an
> existing object data record on entities.
0 Likes