Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SAP PLM
  Excel-VBA als INPLACE im SAP zur Änderung von AutoCAD-Zeichnungen

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:  Excel-VBA als INPLACE im SAP zur Änderung von AutoCAD-Zeichnungen (1110 mal gelesen)
Christian M aus H
Mitglied
Controller

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

Beiträge: 2
Registriert: 03.11.2015

Windows 7, AutoCAD 2016,
SAP 7300.3.10.3296, Patch Level 10, Build 1511726

erstellt am: 03. Nov. 2015 15:34    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 folgendes Problem:

Wir haben ein Fertigstellungsgrad-Tool im SAP aufgebaut, in dem Räume mit Soll- und Ist-Prozentwerten bewertet werden können.
Zur optischen Aufbereitung der Daten verwenden wir AutoCAD-Zeichnungen mit Layern für die Farben und Blöcken für die Prozent-Angaben (Soll/Ist)

Ich habe jetzt in Excel ein Programm erstellt, welches diese Daten von SAP zur Verfügung gestellt bekommt und dann AutoCAD startet, die Zeichnungen lädt und automatisch die Einfärbung der Layer und Beschriftung der Blöcke vornimmt.
Zur Zeit funktioniert dieses Programm als Inplace-Anwendung im SAP im
manuellen Modus (d.h.) SAP lädt die Excel-Datei und der Anwender startet das Makro per Schaltfäche.

Diese funktioniert auch (mit ein paar künstlichen Pausen und MsgBox aufrufen im Makro damit SAP hinterher kommt).

Wenn ich allerdings das Makro automatisch starten möchte ohne weitere Beeinflussung durch den User, gibt es einen Abap Laufzeitfehler im SAP.
Fehler-Kurztext:
Zugriff über 'NULL' Objektreferenz nicht möglich.


Ich habe folgenden Code eingebaut, den ich durch entfernen von 'SPERRE', aktiviere

DieseArbeitsmappe:

Private Sub Workbook_Open()
  'SPERRE' Application.OnKey "{ESC}", ""  ' ESC-Taste aus
  'SPERRE' OpnAcad                        ' Startet das Hauptprogramm
End Sub

Und im Hauptprogramm auch:

'SPERRE'ThisWorkbook.Close 

Ansonsten sind die Programme identisch.

Das hier ist das Programm:

Option Explicit

'Globale Variablendeklaration
Public Graphics As AcadApplication                                          ' AutoCAD als solches
Public Thisdrawing As AcadDocument                                          ' das aktuelle Dokument in AutoCAD
Public AcadVersion, AcadProgrammPfad As String                              ' Speichert die Version der Acad-Anwendung

Public WBErgebnis As Workbook                                              ' Variable für die Ergebnis-Datei
Public WSDaten, WSFehler As Worksheet                                      ' Variablen für die Reiter SAP-Uebergabe und die Fehler-Seiten in der Ergebnis-Datei

'Public Menu As UserForm                                                    ' Status-Fenster

Public Dateipfad, Dateiname As String                                      ' Speichert Dateipfad und -name
Public Bezeichner As String                                                ' Speichert die Örtlichkeit-Art
Public User As String                                                      ' speichert Nutzerkennung
Public Layer_Raum, Layer_Sektion, Layer_Raumbereich As String              ' Ja, falls benutzt werden soll, sonst leer oder nein
Public Block_Raum, Block_Sektion, Block_Raumbereich As String              ' Ja, falls benutzt werden soll, sonst leer oder nein

Public Fehler_Zeile As Long                                                ' Zeile, in der ein Fehler auftritt
Public Fehler_Anzahl, Fehler As Long                                        ' Gesamtfehlerzahl, Zähler

Public Gefunden As Boolean                                                  ' indiziert gefundenen Fehler

'Hier beginnt das eigentliche Hauptprogramm
Public Sub OpnAcad()
    ' Deklaration der örtlichen Variablen
    Dim obj_ACAD_app As AcadDocument                                        ' Ganze Acad-DWG-Zeichnung
    Dim objLayer As AcadLayer                                              ' Variable für Layer
    Dim strDrawing As String                                                ' Zeichnungsname
    Dim Z As Integer                                                        ' Zeilenzähler
    Dim S As Integer                                                        ' Spaltenzähler
    Dim Spalte As Integer                                                  ' Spalte, in der Raum, Sektion und Raumbereich stehen
    Dim i As Long                                                          ' allgemeine Zählvariable
    Dim name As String                                                      '
   
    User = Application.UserName                                            ' Bestimmt die UV-Nummer
    Status "", "Starte aktuelle AutoCAD-Version für", User, ""              ' Füllt Userform mit der Statusanzeige

    On Error Resume Next                                                    ' Wenn Fehler auftritt, nächste Befehlszeile nehmen
    Set Graphics = GetObject(, "AutoCAD.Application")                      ' speichert in Graphics die Autocad-Anwendung
    If Err.Description > vbNullString Then                                  ' Falls fehler auftritt (keine Autocad geladen)
        Err.Clear                                                          ' Fehler löschen
        On Error GoTo kein_Acad
        Set Graphics = CreateObject("AutoCAD.Application")                  ' AutoCAD Starten
    End If
    Graphics.Visible = True                                                ' Autocad anzeigen
   
    AcadVersion = Graphics.FullName                                        ' Speichert den Dateipfad und vollen Namen des Programms
    AcadProgrammPfad = Left(AcadVersion, Len(AcadVersion) - Len("acad.exe"))
    Status "Initialisiere AutoCAD-Version ", AcadVersion, "für", User      ' Füllt Userform mit der Statusanzeige
   
    Z = 11                                                                  ' Setzt Z auf die erste Zeile mit einem Dateinamen
    Set WSDaten = ThisWorkbook.Worksheets("SAP_Uebergabe")
   
    Dateiname = WSDaten.Cells(2, 14).Value & WSDaten.Cells(3, 14).Value    ' Dateiname der Ergebnisdatei
   
    ThisWorkbook.Activate
   
'    Application.Wait Now + TimeSerial(0, 0, 10)                            ' = wartet 10 Sekunden
'    MsgBox (".")
   
    Workbooks.Open (Dateiname)                                              ' Öffnet die Ergebnisdatei
   
    Application.Wait Now + TimeSerial(0, 0, 10)                            ' = wartet 10 Sekunden
    MsgBox ("Bitte bestätigen!")
   
    Set WBErgebnis = ActiveWorkbook                                        ' Belegt Ergebnis-Workbook mit dem neuen Dokument
       
    ThisWorkbook.Activate                                                  ' Diese Datei aktivieren
   
    ' Hier werden die Seiten in der Ergebnisdatei geräumt
    WBErgebnis.Worksheets("Fehlerliste_Raum").Range("3:100000").Delete Shift:=xlUp          'Zeile 3 bis 100.000 (sollte reichen)
    WBErgebnis.Worksheets("Fehlerliste_Sektion").Range("3:100000").Delete Shift:=xlUp
    WBErgebnis.Worksheets("Fehlerliste_Raumbereich").Range("3:100000").Delete Shift:=xlUp
   
    Do                                                                      ' Schleife über alle Zeichnungen
              Layer_Raum = WSDaten.Cells(Z, 3).Value                      ' Soll Layer im Raum gefärbt werden ?, bei "ja": ja, sonst: nein
            Layer_Sektion = WSDaten.Cells(Z, 4).Value                      ' analog Sektion
        Layer_Raumbereich = WSDaten.Cells(Z, 5).Value                      ' analog Raumbereich
              Block_Raum = WSDaten.Cells(Z, 6).Value                      ' Soll Block im Raum beschriftet werden ?, bei "ja": ja, sonst: nein
            Block_Sektion = WSDaten.Cells(Z, 7).Value                      ' analog Sektion
        Block_Raumbereich = WSDaten.Cells(Z, 8).Value                      ' analog Raumbereich
       
              strDrawing = WSDaten.Cells(Z, 1).Value                      ' Zeichnungspfad und Name
   
        Status "Lade AutoCAD-Zeichnung ...", Datei(strDrawing), "", ""      ' Status ausgabe ("Datei" zieht den Dateinamen aus dem Gesamtpfad) (s.u.)
       
        On Error GoTo weiter1
        If strDrawing <> "" Then                                            ' Keine leeren Dateinamen öffnen
            Graphics.Documents.Open (strDrawing)                            ' Öffnet Datei
       
            Set Thisdrawing = Graphics.ActiveDocument                      ' Zieht die aktuelle Zeichnung heran

            With WSDaten                                                    ' Der Block "Datum" muss in der Zeichnung vorhanden sein
                Datum Day(.Cells(4, 1).Value), _
                    Month(.Cells(4, 1).Value), _
                    Year(.Cells(4, 1).Value)                              ' Ruft die Prozedur zum einsetzen des Datums in die Zeichnung auf
            End With
           
            ' Nachfolgend werden der Reihe nach die mit "ja" gekennzeichneten Felder abgearbeitet
            ' Zuerst die Layer, die gefärbt werden,
            ' Danach die Blöcke, die beschriftet werden.
            ' An die Prozedur übergeben wird jeweils die Spalte, in der der Ort steht
            If Layer_Raum = "ja" Then                                      ' Ein kleingeschriebenes "ja" in der Variable
                Bezeichner = "Raum"                                        ' Dann handelt es sich hier um einen Raum-Code
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raum")    ' Speicher für den Reiter in der Ergebnis-Datei
                Faerben (9)                                                ' Prozeduraufruf
                Set WSFehler = Nothing                                      ' Speicherfreigabe
            End If
           
            If Layer_Sektion = "ja" Then                                    ' hier analog
                Bezeichner = "Sektion"
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Sektion")
                Faerben (12)
                Set WSFehler = Nothing
            End If
           
            If Layer_Raumbereich = "ja" Then                                ' hier analog
                Bezeichner = "Raumbereich"
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raumbereich")
                Faerben (15)
                Set WSFehler = Nothing
            End If
           
            ' Jetzt die Blöcke
            If Block_Raum = "ja" Then                                      ' wieder analog
                Bezeichner = "Raum"
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raum")
                Block (9)
                Set WSFehler = Nothing
            End If
           
            If Block_Sektion = "ja" Then
                Bezeichner = "Sektion"
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Sektion")
                Block (12)
                Set WSFehler = Nothing
            End If
           
            If Block_Raumbereich = "ja" Then
                Bezeichner = "Raumbereich"
                Set WSFehler = WBErgebnis.Worksheets("Fehlerliste_Raumbereich")
                Block (15)
                Set WSFehler = Nothing
            End If
        End If
        Z = Z + 2                                                          ' Zwei Zeilen tiefer steht eventuell die nächste Datei
weiter1:
        Err.Clear                                                          ' Fehler löschen und weiter
    Loop Until strDrawing = "SPALTENENDE"                                  ' Bis die Datei "SPALTENENDE" heißt
   
    Set WSDaten = Nothing                                                  ' Freigeben des Speichers
    Set WBErgebnis = Nothing                                                ' Freigeben des Speichers

'SPERRE'ThisWorkbook.Close                                                    ' Dieser Befehl darf nur bei der Original-Live-Datei im SAP gesetzt sein
   
    Status "", "AutoCAD Bearbeitung beendet", "Sie können die Zeichnungen jetzt speichern und drucken", "" ' Füllt Userform mit der Statusanzeige
 
    MS_Form.CB_Beenden.Visible = True                                      ' Beendet die Status-Anzeige
    Exit Sub                                                                ' Beendet das Hauptmakro

'------- Fehlerauswertung ------
kein_Acad:
    MsgBox ("Sie haben kein AutoCAD, bitte wenden Sie sich an die IT")      ' Meldung: Kein ACAD
    Exit Sub                                                                ' Auch Ende
End Sub

' Die nachfolgenden Prozeduren und Funktionen werden von dem Hauptprogramm wiederholt aufgerufen und sind daher aus dem eigentlichen Programmcode extrahiert worden.

' Die Prozedur "Faerben" färbt die sogenannten Layer in einer AutoCAD-Zeichnung mit vorgegebenen Farbwerten, jeh nach Prozentzahl
' Als Parameter wird die Spalte übergeben, in der der Layername gespeichert ist
Public Sub Faerben(ByVal Spalte As Integer)                                ' In Spalte steht die Spaltennummer vom Reiter SAP-Uebergabe (Raum, Sektion, RB)
    ' Deklaration der örtlichen Variablen
    Dim obj_ACAD_app As Object                                              ' Applikation
    Dim objLayer As AcadLayer                                              ' Variable für Layer
    Dim Raum As String                                                      ' Speicher für Raumcode
    Dim Farbe As Double                                                    ' Speicher für Farbe (als Prozentwert)
    Dim Ist, Soll As Double                                                ' Speicher für den Ist- und Soll-Wert
    Dim i As Long                                                          ' Zähler
   
    Status "Einfärbung aller Räume", "mit den aktuellen IST-Prozentwerten ...", "", ""
   
    Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Zieht die aktive AutoCAD Application an
    If Err.Number <> 0 Then                                                ' Falls ein Fehler aufgetreten ist....
        MsgBox "AutoCAD nicht gefunden"                                    ' Abbruch mit Meldung
        Exit Sub
    End If
   
    Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' Zieht die aktive Zeichnung heran
   
    i = 10                                                                  ' in Zeile 10 beginnen die Daten aus SAP
'    Fehler_Anzahl = 1
    Do                                                                      ' Schleife über alle Layer der Zeichnung (?)
        Raum = WSDaten.Cells(i, Spalte).Value                              ' Raumcode aus Excel-Reiter
        If Raum = "SPALTENENDE" Then Exit Do                                ' Kriterium zum Abbruch
        Farbe = WSDaten.Cells(i, Spalte + 1).Value                          ' Farbe (Prozent) aus Excel-Reiter
        Soll = WSDaten.Cells(i, Spalte + 2).Value                          ' Soll aus Excel-Reiter
       
        If Layer_Sektion = "ja" Then Raum = "Kolli " & Raum                ' Sonderfall für F125
       
        Status "Einfärbung aller Räume", "mit den aktuellen IST-Prozentwerten ...", Raum, Format(Farbe, "0%")
       
        On Error Resume Next
        Set objLayer = Thisdrawing.Layers(Raum)                            ' Reserviert Speicher für den aktuellen Raum-Layer
        If Err.Number <> 0 Then                                            ' Falls ein Fehler aufgetreten sein sollte
            Fehler = WSFehler.Cells(Rows.Count, 2).End(xlUp).Row + 1        ' Ausgabe in der Ergebnis-Datei
            WSFehler.Cells(Fehler, 2).Value = Raum
            WSFehler.Cells(Fehler, 3).Value = "nicht in Zeichnung"
            WSFehler.Cells(Fehler, 4).Value = Thisdrawing.name
            GoTo WEITER
        End If
        If Len(Raum) >= 1 Then                                              ' Nur sinnvolle Räume nehmen ( alter Code )
            Select Case Round(Farbe, 4)                                    ' Prozentwerte auf 4 Stellen runden und auswählen
                Case 0:                objLayer.Color = 9                  ' Hellgrau im AutoCAD
                Case 0.005 To 0.245:    objLayer.Color = 8                  ' Dunkelgrau im AutoCAD
                Case 0.2451 To 0.495:  objLayer.Color = 30                ' Orange im AutoCAD
                Case 0.4951 To 0.745:  objLayer.Color = 40                ' Gelb im AutoCAD
                Case 0.7451 To 0.945:  objLayer.Color = 2                  ' Hellgelb im AutoCAD
                Case 0.9451 To 0.99999: objLayer.Color = 60                ' Hellgrün im AutoCAD
                Case 1:                objLayer.Color = 3                  ' Dunkelgrün im AutoCAD
            End Select
            Fehler = WSFehler.Cells(Rows.Count, 5).End(xlUp).Row + 1        ' Ausgabe in der Eregebnis-Datei
            WSFehler.Cells(Fehler, 5).Value = Raum
            WSFehler.Cells(Fehler, 6).Value = Format(Round(Farbe, 2), "0%")
            WSFehler.Cells(Fehler, 7).Value = Thisdrawing.name
        End If
WEITER:
        i = i + 1                                                          ' nächster Raum
        Set objLayer = Nothing                                              ' Speicher für Layer wieder freigeben
    Loop Until Raum = "SPALTENENDE" Or Raum = "Kolli "                      ' Bis zum SPALTENENDE
neuzeichnen:

    Status "", "Einfäbung der Räume abgeschlossen", "", ""
   
    Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen
   
    Status "", "Einfärbung der Räume abgeschlossen", "Zeichnung regeneriert", ""
   
    Set Thisdrawing = Nothing                                              ' Speicher freigeben
    Set objLayer = Nothing                                                  ' Speicher freigeben
    Set obj_ACAD_app = Nothing                                              ' Speicher freigeben

End Sub
     
' Die Prozedur "Block" trägt in einer AutoCad-Zeichnung in sogenannten Blöcken neue Beschriftungen ein (IST- und SOLL-Prozentwerte)
' Als Parameter wird die Spalte übergeben, in der der Blockname gespeichert ist
Private Sub Block(ByVal Spalte As Integer)
    ' Deklaration der örtlichen Variablen
    Dim obj_ACAD_app As Object                                              ' Speicher für AutoCAD
    Dim Entity As AcadEntity                                                ' Speicher für ein Element
    Dim Blockdef As AcadBlock                                              ' Speicher für einen Block
    Dim Text As AcadText                                                    ' Speicher für Text
    Dim Mtext As AcadMText                                                  ' Speicher für MText
   
    Dim Ist, Soll As Double
    Dim i As Integer
    Dim Raum, Ist_Text, Soll_Text As String                                ' Speicher für Raumcode
   
    On Error Resume Next                                                    ' Bei Fehler Anweisung überspringen
    Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Die AutoCAD-Anwendung als solches suchen und Speicher reservieren
    If Err.Number <> 0 Then                                                ' Fehlermeldung jeglicher Art
        MsgBox "AutoCAD nicht gefunden"                                    ' Wird ausgegeben als kein AutoCAD
    End If
   
    Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' aktive Zeichnung auswählen
   
    i = 10                                                                  ' Daten beginnen in Spalte 10
    Do
        Ist_Text = WSDaten.Cells(6, Spalte).Value
        Soll_Text = WSDaten.Cells(7, Spalte).Value
   
        Raum = WSDaten.Cells(i, Spalte).Value                              ' Raumcode aus Excel-Reiter
        If Raum = "SPALTENENDE" Then Exit Do                                ' Ende der Ausgabe
        Ist = WSDaten.Cells(i, Spalte + 1).Value                            ' Farbe (Prozent) aus Excel-Reiter
        Soll = WSDaten.Cells(i, Spalte + 2).Value                          ' Soll aus Excel-Reiter
       
        Status "Beschriftung aller Räume mit Prozentwerten ...", Raum, "Ist: " & Format(Ist, "0%"), "Soll: " & Format(Soll, "0%")
       
        If Right(Ist_Text, 2) = "Nr" And Bezeichner = "Raum" Then Ist_Text = Left(Ist_Text, Len(Ist_Text) - 2) & Raum
        If Right(Soll_Text, 2) = "Nr" And Bezeichner = "Raum" Then Soll_Text = Left(Soll_Text, Len(Soll_Text) - 2) & Raum
   
        If Block_Sektion = "ja" Then Raum = "Kolli " & Raum                ' Sonderfall bei F125

        Set Blockdef = Thisdrawing.Blocks.Item(Raum)                        ' Setzt Blockdef auf diesen Block an
   
        Gefunden = False                                                    ' Noch kein Element gefunden
        For Each Entity In Blockdef                                        ' Durchsuche alle Elemente in den Blöcken
            Select Case LCase(Entity.ObjectName)                            ' Umwandlung der Objektnamen in Kleinbuchstaben
            Case "acdbmtext"                                                ' Hinweis auf Blocknamen
                Set Mtext = Entity
                If InStr(0, Mtext.TextString, Len(Raum)) = Raum Then        ' Sucht im Text des Blocknamens nach dem Raumcode in exakter Länge
                    Select Case Bezeichner
                    Case "Raum":
                        Mtext.TextString = Raum & ": " & Format(Ist, "0%")                                          '01B05: 90%
                    Case "Sektion":
                        Mtext.TextString = Replace(Raum, "Kolli", "Sektion") & " Ist: " & Format(Ist, "0%")        'Sektion 015 Ist: 80%
                    Case "Raumbereich":
                        Mtext.TextString = Raum & " Soll: " & Format(Soll, "0%")                                    '01B05 Soll: 90%
                        Mtext.TextString = Mtext.TextString & vbNewLine & "      " & " Ist: " & Format(Ist, "0%")  '01B05 Soll: 90%
                    End Select                                                                                      '      Ist: 45%
                    Gefunden = True                                        ' Ort gefunden
                End If
                Set Mtext = Nothing                                        ' Speicherfreigabe
            End Select
        Next Entity
       
        If Not Gefunden Then                                                ' Fehlerausgabe in der Ergebnis-Datei
            Fehler = WSFehler.Cells(Rows.Count, 9).End(xlUp).Row + 1
            WSFehler.Cells(Fehler, 9).Value = Raum
            WSFehler.Cells(Fehler, 10).Value = "nicht in Zeichnung"
            WSFehler.Cells(Fehler, 11).Value = Thisdrawing.name
        Else
            Fehler = WSFehler.Cells(Rows.Count, 12).End(xlUp).Row + 1      ' Oder eben den erfolgreichen Übertrag
            WSFehler.Cells(Fehler, 12).Value = Raum
            WSFehler.Cells(Fehler, 13).Value = Format(Round(Ist, 2), "0%")
            WSFehler.Cells(Fehler, 14).Value = Format(Round(Soll, 2), "0%")
            WSFehler.Cells(Fehler, 15).Value = Thisdrawing.name
        End If
       
        If Block_Sektion = "ja" Then                                        ' Bei Sektionsdarstellung brauchen wir noch einen zweiten Block
            Raum = WSDaten.Cells(i, Spalte).Value                          ' Raumcode aus Excel-Reiter
           
            Raum = "Sek-" & Raum                                            ' Dieser heißt "Sek-XXX" (zumindest bei F125)
           
            Set Blockdef = Thisdrawing.Blocks.Item(Raum)                    ' Setzt Blockdef auf den Raum an
            Gefunden = False                                                ' Noch kein Ort gefunden
            For Each Entity In Blockdef                                    ' Durchsuche alle Elemente in den Blöcken
                Select Case LCase(Entity.ObjectName)                        ' Umwandlung der Objektnamen in Kleinbuchstaben
                Case "acdbmtext"                                            ' Hinweis auf Blocknamen ...(?)
                    Set Mtext = Entity                                      ' Richtet einen Speicher für den Text ein
                    If InStr(0, Mtext.TextString, Len(Raum)) = Raum Then    ' Sucht im Text des Blocknamens nach dem Raumcode in exakter Länge
                        Mtext.TextString = Replace(Raum, "Sek-", "Sektion ") & " Soll:" & Format(Soll, "0%")          'Sektion 015 Ist: 80%
                    End If
                    Gefunden = True                                        ' Text-Block gefunden
                    Set Mtext = Nothing                                    ' Speicherfreigabe
                End Select
            Next Entity
        End If
     
        Set Entity = Nothing                                                ' Speicherfreigabe
        Set Blockdef = Nothing                                              ' Speicherfreigabe
        i = i + 1
    Loop Until Raum = "SPALTENENDE" Or Raum = ""                            ' Abbruchkriterium
   
    Set obj_ACAD_app = Nothing                                              ' Speicherfreigabe
    Set Entity = Nothing                                                    ' Speicherfreigabe
    Set Blockdef = Nothing                                                  ' Speicherfreigabe
   
    Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen
End Sub

' DIe Prozedur "Datum" beschreibt in einer AutoCAD-Zeichnung den Block "Datum" mit dem übergebenen Datum in der Form    Stand: XX.XX.XXXX
Private Sub Datum(ByVal Tag, Monat, Jahr As String)
    ' Deklaration der örtlichen Variablen
    Dim obj_ACAD_app As Object                                              ' Speicher für AutoCAD
    Dim Blockdef As AcadBlock                                              ' Speicher für einen Block
    Dim Entity As AcadEntity                                                ' Speicher für ein Element
    Dim Mtext As AcadMText                                                  ' Speicher für MText
   
    On Error Resume Next                                                    ' Bei Fehler Anweisung überspringen
    Set obj_ACAD_app = GetObject(, "AutoCAD.application")                  ' Die AutoCAD-Anwendung als solches suchen und Speicher reservieren
    If Err.Number <> 0 Then                                                ' Fehlermeldung jeglicher Art
        MsgBox "AutoCAD nicht gefunden"                                    ' Wird ausgegeben als kein AutoCAD
    End If
   
    Set Thisdrawing = obj_ACAD_app.ActiveDocument                          ' aktive Zeichnung auswählen
   
    On Error GoTo kein_Datum                                                ' Falls der Block nicht vorhanden ist gehe zu der Sprungmarke
    Set Blockdef = Thisdrawing.Blocks.Item("Datum")                        ' Setzt Blockdef auf den Block "Datum" an
   
    For Each Entity In Blockdef                                            ' Durchsuche alle Elemente in den Blöcken
        Select Case LCase(Entity.ObjectName)                                ' Umwandlung der Objektnamen in Kleinbuchstaben
        Case "acdbmtext"                                                    ' Hinweis auf Blocknamen
            Set Mtext = Entity
            Mtext.TextString = ThisWorkbook.Worksheets("SAP_Uebergabe").Cells(2, 1).Value
            Set Mtext = Nothing                                            ' Speicherfreigabe
        End Select
    Next Entity

kein_Datum:
   
    Set Entity = Nothing                                                    ' Speicherfreigabe
    Set Blockdef = Nothing                                                  ' Speicherfreigabe
    Set obj_ACAD_app = Nothing                                              ' Speicherfreigabe
   
    Thisdrawing.Regen (acAllViewports)                                      ' Zeichnung in AutoCAD auffrischen
End Sub

' Die Prozedur "Status" gibt eine Userform mit 4 Textfeldern aus, in der der aktuelle Bearbeitungsstand ausgegeben wird
Sub Status(ByVal Text1, Text2, Text3, Text4)
    MS_Form.Label1.Caption = Text1                                          ' Texte der Userform belegen mit übergebenen Parametern
    MS_Form.Label2.Caption = Text2
    MS_Form.Label3.Caption = Text3
    MS_Form.Label4.Caption = Text4
    MS_Form.Show                                                            ' Userform anzeigen
    MS_Form.Repaint                                                        ' Userform neuzeichnen
End Sub

' Die Funktion "Datei" liefert aus dem übergebenen Parameter, dere einen Dateipfad darstellen muss, den Dateinamen
Function Datei(ByVal pfad)
    ' Deklaration der örtlichen Variablen
    Dim temp As Variant
   
    Dateiname = ""                                                          ' Funktionsergebnis zunächst leer
    temp = Split(pfad, "\")                                                ' Splittet den übergebenen Pfad in ein Array getrennt durch "\"
    On Error Resume Next                                                    ' Falls kein Dateiname übergeben wurde
    Datei = temp(UBound(temp))                                              ' Das letzte Feld im Array ist der Dateiname
End Function


Ich weiß, daß es sich hierbei um eine sehr komplexe Fragestellung handelt, aber vielleicht habe ich ja glück und jemand kennt das Problem !!

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