VBA Edit object data
vadivelan
I am new to this VBA autodeskmap 2004.... We are working on object data manually. I want to automate some tasks.
Where I can get some samples programs to work (vba) with edit object data table.
Thanks in advance
P.V.Velan
bart1123
The Help Files are an excellent resource for API regarding Object data.
In Map HELP>AUTODESK MAP HELP F1>PROGRAMING INTERFACES>ACTIVE X AUTOMATION API HELP>INDEX>"Object Data Tables, ! Sample Code"
In the code you will see the line
Set amap = ThisDrawing.Application. GetInterfaceObject("AutoCADMap.Application")
The last part of that needs to read ("AutoCADMap.Application.2")
for Map 2004
Hope this helps
Bart
javaknight
Bart1123
I have been unsuccessful in running 2004 with any earlier versions of map on the same machine (without the use of a virtual PC installed), however the .2 is the only change that I have found in the API, so creating 2 versions of the application will be easy. Getting the proper version to the correct machine may be a bit of a challange.
Sorry if this is not as helpful as you might need
Bart
JLO
for any version of autocad.
and now with AutoCAD 2005 again i have to do changes to my applications
because Autodesk change some objects in the new version.
i hate this but...
here i am!!!
bye
"javaknight" <nos...@address.withheld> escribió en el mensaje
news:31268979.108758630...@jiveforum1.autodesk.com...
vadivelan
I worked with the sample codes given in the help.
But I want to insert some data into a particular column in the object data table using VBA. How to do this.???
P.Vadivelan
vittal
Function funcsingleGenIncrnumber(ByVal elem As AcadGroup, table_name As String, FieldName As String, uidpref$, uidsuff$, sset2 As Variant)
Dim acadApp As Object, amobj As Object, odRecs As Object, odtbls As Object, odFlds As Object
Dim prj As Object
Dim row As Object, inctxt$, FieldCnt%
Dim lp1%, nofeildcnt%, objTable As Object, odfld As Object, bStatus As Variant
Dim Stat As Variant
Dim elem2 As AcadEntity, uidtext$
Set acadApp = ThisDrawing.Application
If InStr(1, ThisDrawing.Application.Version, "15") <> 0 Then
Set amobj = acadApp.GetInterfaceObject("AutoCADMap.Application")
Else
Set amobj = acadApp.GetInterfaceObject("AutoCADMap.Application.2")
End If
Set prj = amobj.Projects(ThisDrawing)
Set odtbls = prj.ODTables
Set odFlds = odtbls((table_name)).ODFieldDefs
Dim flg As Boolean
FieldCnt = 0: flg = False
For Each odfld In odFlds
If UCase(odfld.Name) = UCase(FieldName) Then
flg = True
Exit For
End If
FieldCnt = FieldCnt + 1
Next
If flg = False Then
MsgBox "Field name not exist" & " " & UCase(FieldName), vbCritical
Exit Function
End If
Set objTable = prj.ODTables((table_name))
Set row = objTable.CreateRecord()
Set odRecs = objTable.GetODRecords
incr_number = 0
Dim maxnumber&
maxnumber = 0
For Each elem2 In sset2
If elem.Layer = elem2.Layer Then
Set odRecs = objTable.GetODRecords
bStatus = odRecs.Init(elem2, False, True)
If odRecs.IsDone = False Then
Set row = odRecs.Record
If row.Item((FieldCnt)).Value <> "" Then
incr_number = Mid(row.Item((FieldCnt)).Value, Len(uidpref) + 1, InStr(1, row.Item((FieldCnt)).Value, "-") - Len(uidpref) - 1)
If maxnumber < incr_number Then
maxnumber = incr_number
End If
End If
End If
Set odRecs = Nothing
End If
Next
incr_number = maxnumber + 1
uidtext = uidpref & incr_number & uidsuff
Set odRecs = objTable.GetODRecords
bStatus = odRecs.Init(elem, True, True)
If odRecs.IsDone = False Then
Set row = odRecs.Record
Stat = odRecs.Remove
Set odRecs = Nothing
row.Item((FieldCnt)).Value = uidtext
row.AttachTo (elem.ObjectID)
Set odRecs = Nothing
MsgBox uidtext, vbInformation
Else
If UCase(table_name) <> "STRUCTR" Then
Set odRecs = Nothing
row.Item((FieldCnt)).Value = uidtext
row.AttachTo (elem.ObjectID)
Set odRecs = Nothing
MsgBox uidtext, vbInformation
End If
Set odRecs = Nothing
End If
Set amobj = Nothing
Set prj = Nothing
Set odtbls = Nothing
Set odRecs = Nothing
End Function
Vittal TS
javaknight
vadivelan
Thanks for sharing the code.
Could you explain me, the parameters elem, uidpref, uidsuff, for these what i have to send. Finally, what data will be inserted inot the field.
I'm new to this VBA, plz help me.
Thanks.
P.V.Velan
vittal
uidpref, uidsuff is string value that iam updating in object data
Vittal
Rico van Driel
example. Here is some code i use to update object data of elements in a
drawing
---------------------
Sub VervangenID() 'replaceID
Dim amap As AcadMap
Dim acadObj As Object
Dim ODtb As ODTable
Dim i As Integer
Dim prj As Project
Dim ODrcs As ODRecords
Dim boolVal As Boolean
Dim NieuwObjectData As Object 'Help object for change
Dim Teller As Long 'just a counter
Set amap =
ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
Set prj = amap.Projects(ThisDrawing)
prj.ProjectOptions.DontAddObjectsToSaveSet = True
Set ODtb = prj.ODTables.Item("WorkshopWaarde")
'this is the tablename i want the attributes to change
Set ODrcs = ODtb.GetODRecords
Teller = 50
For Each acadObj In ThisDrawing.ModelSpace
If acadObj.ObjectName = "AcDbMPolygon" Then
' in this example i am just interested in mpolygon objects
boolVal = ODrcs.Init(acadObj, True, False) 'init function to tell
change is allowed
'Debug.Print ODrcs.Record.tableName 'show information in the
immediate window
'Debug.Print ODrcs.Record.ObjectID 'show information in the
immediate window
'For i = 0 To ODrcs.Record.Count - 1 'show information in the
immediate window
' Debug.Print ODrcs.Record.Item(i).Value 'show information in the
immediate window
'Next i
'Debug.Print ODrcs.Record.Item(0).Value
Set NieuwObjectData = ODrcs.Record 'set old values to a object
NieuwObjectData.Item(0).Value = Teller 'replace values
Teller = Teller + 1
Resultaat = ODrcs.Update(NieuwObjectData) 'replace existing object
with object with new values
End If
Next
Set ODrcs = Nothing 'release odrcs
MsgBox "Commando Uitgevoerd" 'message done
End Sub
--------------------------
Rico
"vadivelan" <nos...@address.withheld> schreef in bericht
news:19833588.108727631...@jiveforum1.autodesk.com...