Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  2D CAD Editor
  Blockreferenzen mit VBA bearbeiten

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
Autor Thema:  Blockreferenzen mit VBA bearbeiten (1712 mal gelesen)
insidERR
Mitglied
2/3D Konstruktion, VBA/.net Programmierung, EDV


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

Beiträge: 119
Registriert: 27.08.2007

erstellt am: 17. Jun. 2010 13:28    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 Leute,
ich suche nach einer Möglichkeit via VBA Blockreferenzen, die in einem Block sind zu bearbeiten.
In AutoCAD läuft es wurderbar, jetz würde ich es gerne auch im DWGeditor zum laufen kriegen.

Code:

Public Sub fillTypenschild(MaschinenNr As String, Maschinenbezeichnung As String, Pumpenbezeichnung As String, Jahr As String, _
                        qWert As String, nWert As String, tWert As String, hWert As String, pWert As String, RhoWert As String) 'Typenschildfelder ausfüllen
    Dim BlockCol As Collection, Objekt As Object
    Set BlockCol = New Collection
    For Each Objekt In ThisDrawing.ModelSpace  'In Excel muss "Thisdrawing" durch "ActiveDocument" ersetzt werden
    If Objekt.ObjectName = "AcDbBlockReference" Then
        If Objekt.Name = "Typenschild" Then
                BlockCol.Add Objekt
                GoTo n
        End If
    End If
    Next
    ThisDrawing.Utility.Prompt vbNewLine & "Block Typenschild nicht gefunden"
    Exit Sub
n:
    Dim AktBlock As AcadBlockReference
    Set AktBlock = BlockCol(1)
    AktAtt = AktBlock.GetAttributes

            For j = 0 To UBound(AktAtt)
                DoEvents
                If AktAtt(j).TagString = "MACHINE_NO" Then AktAtt(j).TextString = MaschinenNr
                If AktAtt(j).TagString = "CLIENTS_NO" Then AktAtt(j).TextString = Maschinenbezeichnung
                If AktAtt(j).TagString = "TYPE" Then AktAtt(j).TextString = Pumpenbezeichnung
                If AktAtt(j).TagString = "YEAR" Then AktAtt(j).TextString = Jahr
                If AktAtt(j).TagString = "Q" Then AktAtt(j).TextString = qWert
                If AktAtt(j).TagString = "N" Then AktAtt(j).TextString = nWert
                If AktAtt(j).TagString = "T" Then AktAtt(j).TextString = tWert
                If AktAtt(j).TagString = "H" Then AktAtt(j).TextString = hWert
                If AktAtt(j).TagString = "P" Then AktAtt(j).TextString = pWert
                If AktAtt(j).TagString = "RHO" Then AktAtt(j).TextString = RhoWert
            Next
            ThisDrawing.Regen acActiveViewport 'aktualisiert die Zeichnung
            ThisDrawing.Utility.Prompt vbNewLine & "Typenschild wurde ausgefüllt"
End Sub


Das Makro sucht die gesamte Zeichnung nach dem Block "Typenschild" und ändert dann die dort enthaltenen Blockatribute. Jetzt soll es auf einem Rechner laifen, wo DWGeditor und nicht AutoCAD installiert ist laufen.

Hat einer ne IDee wie man den Code umfrickelt, dass er auch im DWGeditor laufen kann?
Ich scheitere schon an dem richtigen Ersatz für "AcDbBlockReference". Finde auch keine Doku dazu.

Danke  :-)

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

insidERR
Mitglied
2/3D Konstruktion, VBA/.net Programmierung, EDV


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

Beiträge: 119
Registriert: 27.08.2007

Win10 x64 Pro, ACAD Mech.2022, AI 2022 Sim., AV WG 2022, VBA/.NET

erstellt am: 21. Jun. 2010 16:58    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

Problem selbst gelöst.
Hier der Code(vielleicht kanns jemand gebrauchen):

Code:

Public Sub fillTypenschild(MaschinenNr As String, Maschinenbezeichnung As String, Pumpenbezeichnung As String, Jahr As String, _
                        qWert As String, nWert As String, tWert As String, hWert As String, pWert As String, RhoWert As String) 'Typenschildfelder ausfüllen
    Dim BlockCol As Collection, Objekt As Object
    Set BlockCol = New Collection
    For Each Objekt In ActiveDocument.ModelSpace  'In Excel muss "Thisdrawing" durch "ActiveDocument" ersetzt werden
   
        If Objekt.Name = "Typenschild_DE" Then
                BlockCol.Add Objekt
                GoTo n
        End If

    Next
    ActiveDocument.Utility.Prompt vbNewLine & "Block Typenschild nicht gefunden"
    Exit Sub
n:
    Dim AktBlock As Collection
    Set AktBlock = BlockCol
    AktAtt = AktBlock(1)

            For j = 2 To 11
                DoEvents
                If AktBlock(1).Parent(j).TagString = "MACHINE_NO" Then AktBlock(1).Parent(j).TextString = MaschinenNr
                If AktBlock(1).Parent(j).TagString = "CLIENTS_NO" Then AktBlock(1).Parent(j).TextString = Maschinenbezeichnung
                If AktBlock(1).Parent(j).TagString = "TYPE" Then AktBlock(1).Parent(j).TextString = Pumpenbezeichnung
                If AktBlock(1).Parent(j).TagString = "YEAR" Then AktBlock(1).Parent(j).TextString = Jahr
                If AktBlock(1).Parent(j).TagString = "Q" Then AktBlock(1).Parent(j).TextString = qWert
                If AktBlock(1).Parent(j).TagString = "N" Then AktBlock(1).Parent(j).TextString = nWert
                If AktBlock(1).Parent(j).TagString = "T" Then AktBlock(1).Parent(j).TextString = tWert
                If AktBlock(1).Parent(j).TagString = "H" Then AktBlock(1).Parent(j).TextString = hWert
                If AktBlock(1).Parent(j).TagString = "P" Then AktBlock(1).Parent(j).TextString = pWert
                If AktBlock(1).Parent(j).TagString = "RHO" Then AktBlock(1).Parent(j).TextString = RhoWert
            Next
            ActiveDocument.Regen acActiveViewport 'aktualisiert die Zeichnung
            ActiveDocument.Utility.Prompt vbNewLine & "Typenschild wurde ausgefüllt"
End Sub



Einziger Hacken an dem Code ist, dass man die Textattribute "gezielt" ansprechen muss. Kann also nicht nach einem bestimmten Block/Attribute gesucht werden. Wer es kann, soll's posten.

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)2021 CAD.de | Impressum | Datenschutz