Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Objektdaten ändern funktioniert nicht (odrecord)

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Objektdaten ändern funktioniert nicht (odrecord) (2284 mal gelesen)
Michael Brauchart
Mitglied
Bautechniker

Sehen Sie sich das Profil von Michael Brauchart an!   Senden Sie eine Private Message an Michael Brauchart  Schreiben Sie einen Gästebucheintrag für Michael Brauchart

Beiträge: 9
Registriert: 09.12.2010

erstellt am: 09. Dez. 2010 16:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,
ich habe das Problem, dass ich Objektdaten einzelner Objekte ändern möchte.
Die Objekte haben bereits Objektdaten und es sollen nur deren Werte geändert werden.
Ich schaffe es auch, den ODrecord zu ändern (siehe Programmcode weiter unten), eine Übernahme des geänderten Wertes durch die einzelnen Objekte erfolgt jedoch nicht. Ich denke mir, dass irgend etwas wie ein Update fehlen muss.
Ich hoffe, mir kann jemand von Euch helfen.
Besten Dank und liebe Grüße
Michael

Programmcode:

  Dim FilterType(0) As Integer
  Dim FilterData(0) As Variant

  ''Definitionen für Objektdaten
  Dim odTables As odTables
  Dim odTable As odTable
  Dim RecordIterator As odRecords
  Dim odRecord As odRecord
  Dim odValue As ODFieldValue
  Dim amap As AcadMap
  Set amap = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
 
  On Error Resume Next
  Set sset = ThisDrawing.SelectionSets.Add("SS10")
  Set sset = ThisDrawing.SelectionSets.Item(0)
  sset.Clear
 
  On Error GoTo 0
 
  FilterType(0) = 0
  FilterData(0) = "POLYLINE"
  sset.SelectOnScreen FilterType, FilterData
  Liniennummer = 0
  MaxZ = 0
  For Each mim In sset 'Alle 3d Polylines durchlaufen
      anzahl = UBound(mim.Coordinates)
      anzahl = (anzahl + 1) / 3
      For i = 0 To anzahl - 1
        temp = mim.Coordinate(i)
        If temp(2) > MaxZ Then MaxZ = temp(2)
      Next i

      Set odTables = amap.Projects(ThisDrawing).odTables
      For Each odTable In odTables
        Set RecordIterator = odTable.GetODRecords ''get the selected object data table and iterator
        If RecordIterator.Init(mim, True, False) = True Then 'initilize iterator on entity
          If RecordIterator.IsDone Then '' oops, that entity has no od attached to specified table
              msg = msg & "Entity has no data from Object Data Table:" & odTable.Name
          End If
          Do Until RecordIterator.IsDone
              Set odRecord = RecordIterator.Record
              odRecord(80).Value = MaxZ 'Weist den Maximalen Z-Wert von der 3DPoly zu
              ''odRecord.AttachTo (mim.ObjectID) <-- diese Zeile erzeugt immer einen Fehler im Programmablauf
             
              RecordIterator.Next
          Loop
        Else
          msg = "Error iterating Object Data Table: " & odTable.Name
        End If
      Next 'Ende For Each odTable
  Next ''Ende Each mim

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP


Ex-Mitglied

erstellt am: 09. Dez. 2010 18:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

herzlich willkommen bei CAD-de! 

Bevor ich mir den Code ansehe, wäre vorteilhaft (eher notwendig):

a) welche Map-Version (oder Civil-Version) hast Du
b) welches ServicePack dazu
c) eine Musterzeichnung (paar Geometrieelemente mit OD), die mit diesem Tool Schwierigkeiten macht.

So ganz ohne machts nicht wirklich Sinn - alfred -

------------------
www.hollaus.at

Michael Brauchart
Mitglied
Bautechniker

Sehen Sie sich das Profil von Michael Brauchart an!   Senden Sie eine Private Message an Michael Brauchart  Schreiben Sie einen Gästebucheintrag für Michael Brauchart

Beiträge: 9
Registriert: 09.12.2010

erstellt am: 09. Dez. 2010 18:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,
zu den Fragen:

AutoCAD Civil 3D 2008

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP


Ex-Mitglied

erstellt am: 09. Dez. 2010 18:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

b) und c) 

- alfred -

------------------
www.hollaus.at

Michael Brauchart
Mitglied
Bautechniker

Sehen Sie sich das Profil von Michael Brauchart an!   Senden Sie eine Private Message an Michael Brauchart  Schreiben Sie einen Gästebucheintrag für Michael Brauchart

Beiträge: 9
Registriert: 09.12.2010

erstellt am: 09. Dez. 2010 18:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Beispiel.zip

 
Hallo,
zu den Fragen:
a) Version: AutoCAD Civil 3D 2008
b) ServicePack: keines
c) eine Musterzeichnung: anbei als Anhang

Ich habe als Anhang eine Musterzeichnung, sowie das VBA File eingefügt.

Das Programm soll folgendes machen:
Man muss 3d-Polylininen auswählen.
Danach wird der maximale z-Wert jeder Polyline ermittelt.
Dieser Wert soll dann in das Objektdata Wasssertiefe (welches bereits besteht) des Objektes eingetragen werden (ursprünglicher Wert wird überschreiebn).
Eigentlich ganz einfach - sollte man meinen :-(

Aber ich denke, dass es gar nicht von der Version abhängt, sondern dass ich einfach einen Befehl nicht habe (kenne), welcher bewirkt, dass die Änderungen, welche ich im Objekt odRecord vornehme, auf mein AutocadElement übertragen wird (Update des Objektes und Aktualisierung der zugehörigen Objektdaten).
Denk ich jedanfalls :-)

lg
Michael

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP


Ex-Mitglied

erstellt am: 09. Dez. 2010 20:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

ersetze mal Deine Schleifen durch dieses:

Code:
Const myTableName As String = "Default_HQ100_Ueberflutun"
Dim tODRecords As ODRecords
Dim tODRecord As odRecord
Dim tODTable As odTable
     
Set tODTable = amap.Projects(ThisDrawing).odTables(myTableName)
Set tODRecords = tODTable.GetODRecords
Call tODRecords.Init(mim, True, True)
Set tODRecord = tODRecords.Record
tODRecords.Remove
Set tODRecords = Nothing
     
Set tODRecordnew = tODTable.CreateRecord
Set tODRecordnew = tODRecord
tODRecordnew("Wassertiefe").Value = MaxZ
Call tODRecordnew.AttachTo(mim.ObjectId)

Hintergrund des Ganzen:

a) um Objektdaten zu modifizieren musst Du (leider) den ODRecord vom Objekt entfernen, einen neuen erstellen und diesen dem Objekt wieder zuweisen

b) nicht durch alle Tables durchscannen, zum einen nehme ich an, Du weisst im Code, in welche Table Du schreiben willst. Dein Code hätte, würden einem Geometrieelemente Records mehrerer Tabellen zugeordnet sein, in alle Tabellen im jeweiligen Record ins Feld 80 hineinschreiben (versuchen).

c) auch der Fieldindex (80) kannst Du ersetzen gegen den FieldName ==> solltest Du mal die Objektdatentabellenstruktur modifizieren (neue Fields einfügen), dann willst Du ja nicht Deine Programme umschreiben.

Viel Erfolg, HTH, - alfred -


PS:
>> Aber ich denke, dass es gar nicht von der Version abhängt

Da geb ich Dir nur zum Teil recht, im Map gibt es schon die eine oder andere Sonderbarkeit, die nur in bestimmten Versionen auftritt (SP würd ich übrigens dringend empfehlen).
Zum anderen möchte ich nicht unbedingt jetzt (als Helfer) Zeichnung mit Objektdatenstruktur bauen, um Dein Codeschnippsel zu testen und dann vielleicht draufzukommen, bei mir geht's, bei Dir nicht.   

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 09. Dez. 2010 editiert.]

Michael Brauchart
Mitglied
Bautechniker

Sehen Sie sich das Profil von Michael Brauchart an!   Senden Sie eine Private Message an Michael Brauchart  Schreiben Sie einen Gästebucheintrag für Michael Brauchart

Beiträge: 9
Registriert: 09.12.2010

erstellt am: 10. Dez. 2010 09:26    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Besten Dank für die rasche und kompetente Hilfe!!
Hat super funktioniert.
Werde das Forum in Zukunft sicherlich regelmäßig besuchen - eventuell kann ja auch ich einmal helfen   

Eine Anmerkung noch:
Die Codezeile
  Set tODTable = amap.Projects(ThisDrawing).odTables(myTableName)
verursachte einen Autocad-Absturz (nicht mein VBA-Programm, sondern gleich das ganze ACAD verabschiedete sich) bei der Version Civil 2008 (ohne SP).
Änderung der Zeile auf einen Index anstatt der myTableName-Variable schaffte Abhilfe. Wenn auch mit Nachteilen (gezieltes Ansprechen dar Tabelle nicht möglich).
  Set tODTable = amap.Projects(ThisDrawing).odTables(0)
In der Version Civil 2010 (ohne SP) funktionierte der Befehl mit der myTableName-Variable aber wieder und ACAD stürzte nich ab.

Abschließend noch - falls es Jemanden interessiert - der Programmcode meiner kleinen Routing:

Public Sub PolySpeichern()
 
  Dim FilterType(0) As Integer
  Dim FilterData(0) As Variant
  'Definitionen für Objektdaten
  Dim amap As AcadMap
  Set amap = ThisDrawing.Application.GetInterfaceObject("AutoCADMap.Application")
  Const myTableName As String = "Default_HQ100_Ueberflutun"
  Dim tODRecords As ODRecords
  Dim tODRecord As odRecord
  Dim tODTable As odTable
 
  On Error Resume Next
  Set sset = ThisDrawing.SelectionSets.Add("SS10")
  Set sset = ThisDrawing.SelectionSets.Item(0)
  sset.Clear
 
  On Error GoTo 0
 
  FilterType(0) = 0
  FilterData(0) = "POLYLINE"
  sset.SelectOnScreen FilterType, FilterData
  Liniennummer = 0
  MaxZ = 0
  For Each mim In sset 'Alle 3d Polylines durchlaufen
      anzahl = UBound(mim.Coordinates)
      anzahl = (anzahl + 1) / 3
      For i = 0 To anzahl - 1
        temp = mim.Coordinate(i)
        If temp(2) > MaxZ Then MaxZ = temp(2)
      Next i
      Set tODTable = amap.Projects(ThisDrawing).odTables(0) 'für ACAD Version 2008
      'Set tODTable = amap.Projects(ThisDrawing).odTables(myTableName) 'für ACAD Version 2010
      Set tODRecords = tODTable.GetODRecords
      Call tODRecords.Init(mim, True, True)
      Set tODRecord = tODRecords.Record
      tODRecords.Remove
      Set tODRecords = Nothing
   
      Set tODRecordnew = tODTable.CreateRecord
      Set tODRecordnew = tODRecord
      tODRecordnew("Wassertiefe").Value = MaxZ
      Call tODRecordnew.AttachTo(mim.ObjectID)

  Next 'Ende Each mim
 
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz