---

Hallo zusammen!

Ich möchte Zeichnungen aus einem Verzeichnis der reihenach öffen, bearbeiten, speichern und anschließend wieder schließen.
Dieses soll wenn eben möglich in einem automatischen Durchlauf stattfinden.

Das ganze unter AutoCAD 2009 bzw. 2010.
Muß ich da noch etwas bzgl. dynamische Blöcke berücksichtigen.
Diese könnten evtl. in solch einer Zeichnung enthalten sein.

Die Bearbeitungen sollen wie folgt aussehen:
- Zeichnung bereinigen
- Zoom Grenzen
- Zeichnung speichern und schließen

Den Fortschritt würde ich gerne mittels Progressbar darstellen.

Dieses habe ich bislang.

Code:

---

Private Sub cmdDurchlauf_Click()
If TextBox1.Text = "" Then GoTo MyErrorHandler
Dim Dateiname As String
Dim ImportPfad As String
ImportPfad = TextBox1.Value & "\"

Dim DateiZahl As String
Dim i As Integer
i = 0
DateiZahl = Dir$(ImportPfad & "*.dwg")
Do While DateiZahl <> ""
    i = i + 1
    DateiZahl = Dir$()
Loop
Me.ProgressBar1.Max = i
Dateiname = Dir(ImportPfad & "*.dwg")
Do While Dateiname <> ""
    ThisDrawing.Application.Documents.Open Dateiname
    Me.Caption = Dateiname
    ThisDrawing.PurgeAll
    ZoomExtents
    ThisDrawing.Save

    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop

Me.Caption = "Durchlauf beendet"
ProgressBar1.Value = 0

    Exit Sub
MyErrorHandler:
    MsgBox "Es wurde kein Verzeichnis ausgewählt", 64, "Hinweis"

End Sub

---

Hier hägt sich das Programm aber ab hier auf:

Code:

---

ThisDrawing.Application.Documents.Open Dateiname

---

Könnte mir da jemand weiterhelfen?

Vielen Dank im voraus.

Gruß

Dirk

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

---

Hi,

wissen kann ich's jetzt mal nicht, weil nicht probiert, ABER: Du verwendest
ThisDrawing.Application.Documents.Open Dateiname
Und tauscht aber laufend Dateien (unter Deinem VBA) aus, damit wird 'ThisDrawing', auf welches Du am Anfang Deines Ablaufs verweist, möglicherweise ungültig.

Probier mal am Anfang Deines Codes:

Code:

---

Dim tAcadApp as AcadApplication
Set tAcadApp = ThisDrawing.Application
'.....
'...und ab jetzt greif bitte ThisDrawing nicht mehr an, sondern z.B.
Dim tAcadDoc as AcadDocument
Set tAcadDoc = tAcadApp.Documents.Open(Dateiname)
tAcadDoc.PurgeAll
'....

---

HTH, - alfred -

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

---

Hallo Alfred,

darf ich dir offtopic mal ne Frage stellen.
Du verwendest bei den Variablen das Präfix "t". Wofür steht den das? Kann man diese Konventionen irgendwo nachlesen? Oder ist das dein eigener Stil?
Ich kenne bisher nur lbl.. txt.. boo... etc.

lg und Frohe Weihnachten
didi

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

---

Hallo Dirk,

Dann ändere deinen Code so wie Alfred es beschrieben hat.

Allerdings muss die Zeile:

Set tAcadDoc = tAcadApp.Documents.Open(Dateiname)

um den Pfad ergänzt werden:

Set tAcadDoc = tAcadApp.Documents.Open(ImportPfad & Dateiname[/b])

Sonst wird die Datei nicht gefunden.
Ausserdem würde ich die Datei nach dem speichern noch schliessen.  

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 21. Dez. 2009 editiert.]

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

---

Hi,

@Didi:
>> Du verwendest bei den Variablen das Präfix "t". Wofür steht den das?

...eigener Stil! Das mit oXXX (für Objekt) und iXXX (für Integer) ... halte ich heutzutage nicht mehr für sinnvoll, da Dir (bei ordentlicher Variablendeklaration) jede Entwicklungsumgebung die Typkonflikte sofort (beim Editieren) anzeigt. Demgegenüber sehe ich die Notwendigkeit, aus Variablennamen den Gültigkeitsbereich unterscheiden zu können. Damit gibt's

- tXXX für temporäre Variable, gültig nur in der Function/Sub (im vb.NET sogar nur im Bereich von For-Next oder If-EndIf)

- pXXX für Variable, die 'private' deklariert sind und je Klasseninstanz gelten (in anderen Schreibweisen oft '_XXX' oder 'm_XXX'

- XXX (ohne Präfix) für Variable, öffentlich, instanzübergreifend (shared) gültig

Bei Form-Controls halte ich mich dann an TXT...für Textboxes, LBL...für Label, COMB...für Comboboxen, aber das eigentlich nur, dass ich in Falle komplexer Forms zumindest über die Sortierung ein Control in Eigenschaftsfenster wiederfinde.

Aber eben eigener Stil, richtet sich nach nichts mir bekanntem, das öffentlich-empfohlen wäre. Kommt wohl >>>diesem<<< hier am nächsten (wobei ich es doch auch gut begründen kann).  

- alfred -

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

[Diese Nachricht wurde von a.n. am 21. Dez. 2009 editiert.]

---

Hallo Alfred,

ja, das klingt schon recht vernünftig. Danke für die Auskunft.

lg
didi

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

---

und noch zum Dritten;-)
Ergo versuche mal bei deinem Code mit Acad so zu verfahren,
als würdest du von aussen (andres Proggi oder VB) zugreifen und auch ganz
stur immer die Application oder das Document voranstellen.
Kann manchmal sehr heimtückisch sein, wenn man's nicht tut.

Um mal bei Alfreds Snippet zu bleiben:

Code:

---

with tAcadDoc
.PurgeAll
tAcadApp.zoomextents
.save
.close 'besser ist's Carsten;-)
end with

---

Aber noch eine kleine (dumme) Frage:

Code:

---

Dim tAcadApp As AcadApplication: Set tAcadApp = AcadApplication
'und
Set tAcadApp = ThisDrawing.Application

---

dürfte unterm Strich genau dasselbe sein, nur dass Ersteres direkter ist und ich mit letzterem über Thisdrawing ranhangel.

Didis Frage habe ich mir auch gestellt, was das 't' means;-)
Bei Object's kenn ich nur objName.

[trekkedi: Eh' ich so aus der Suppe komme,
hat Alfred beantwortet und Didi ebenfalls ...    ]

lg Nancy

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

---

Hi,

@Nancy:
>> Aber noch eine kleine (dumme) Frage:
      Dim tAcadApp As AcadApplication: Set tAcadApp = AcadApplication
      'und
      Set tAcadApp = ThisDrawing.Application
>> dürfte unterm Strich genau dasselbe sein, nur dass Ersteres direkter ist und
>> ich mit letzterem über Thisdrawing ranhangel

Da sieht man mal wieder, was es ausmacht, wenn ein API-Entwickler gleichnamige Funktionsdeklarationen und Typ-Deklarationen in eine API verpackt. Die schlupfen dann aus dem Wissen raus, weil man/Frau vorsichtig ist und diesem (potentiellen Konflikt) am besten aus dem Weg geht. 

Aber hast schon recht, in diesem Fall absolut berechtigter Einwand. 

- alfred -

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

---

@alfred
> Aber hast schon recht, in diesem Fall absolut berechtigter Einwand.

Das klingt jetzt so als sei ich der Oberguru, Hülfeee,
sooo war das garnicht gemeint, und bin ich auch nicht, höchstens ein Zauberlehrling und du der Hexenmeister 

Alfred, neenee das war kein Einwand, sondern wirklich eine Frage. 
Einfach weil ich dein 'Thisdrawing.application' irgendwie clever fand,
zumindest denke ich das auch jetzt noch, vorrausgesetzt man macht was innerhalb von Acad. Auf die Idee bin ich jedenfalls noch nicht gekommen und dachte .... naja irgendwie clever eben.

CU Nancy

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

---

Hi,

noch eine Ergänzung zu dem ursprünglichen Thema

>> Muß ich da noch etwas bzgl. dynamische Blöcke berücksichtigen

ich gebe zu, das nicht so (aufmerksam) interpretiert zu haben wie cadffm  (DANKE!)
Damit eine weitere Erklärung zu:

Enthält die Zeichnung eine oder mehrere Referenzen einer dynamischen Blockdefinition, dann kein Problem, Handling wie oben angeführt.

Ist die zu öffnende Zeichnung selbst eine Blockdefinition (mit dynamischen Eigenschaften), dann ist der Weg allerdings zu überdenken, denn dann folgt von AutoCAD die Abfrage 'wollen Sie diese Zeichnung im Blockeditor öffnen?'
Und da kann man zwar die SysVar 'blockeditlock' verwenden, um das öffnen des Blockeditors zu verhindern, dann wiederum kommt aber die Abfrage 'Die Zeichnung enhält Erstellungselemente, die nicht bearbeitet werden können, ...', auch dieser Dialog läßt sich mit keinem mir bekannten Mittel auflösen (SysVar 'expert', 'cmddia'). Also endet dieser Vorgang wohl oder übel in einem Dialog, der manuellen Eingriff erforderlich macht.

Sollte das Ziel sein, dass Blockdefinitionen überarbeitet werden (damit keine Layouts in den DWG's vorhanden sind), dann gibt es als grünes Licht aber die Variante, die Zeichnung nicht mit 'öffnen' zu laden, sondern mit '_insert' in eine leere Zeichnung hereinzuholen und dann mit '_wblock' nach der Modifikation zu speichern.

HTH, - alfred -

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

---

Hallo und guten Morgen zusammen!

Vielen Dank für die Infos.
Da sind ja interessante Dinge dabei, auch so Allgemein gesehen.

Hi Alfred!
>> Muß ich da noch etwas bzgl. dynamische Blöcke berücksichtigen
Das scheint das Hauptproblem zu sein.

Ich werde es hier wohl mit
>>... '_insert' in eine ... dann mit '_wblock' ... speichern
umsetzen müssen.

Noch mal vielen Dank an alle.

Gruß

Dirk

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

---

Hi Dirk,

Die Dateien, die bearbeitet werden sollen, enthalten nur den dynamischen Block?!
Oder Handelt es sich um Zeichnungen, die dynamische Blöcke enthalten können?!
Für den zweiten Fall hättest du ja hier den Lösungsweg.
Für den ersten Fall könntest du das Makro abändern, was du zum erzeugen der WMFs hast.
Den Beitrag hab ich jetzt aber nicht zur Hand.

Gruß, Carsten

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

---

DWG_FORMAT.dvb.txt

Hi Carsten!

...das mit den wmf's hab ich mir schon mal dazu genommen.

Habs mal umgeschrieben.
Es läuft zwar soweit durch, nur wie bekomme ich es hin, daß der
Virtuelle Stil auf 2DDrahtkörper umgestellt wird?
Habs Progrämmchen mal angehangen.

Code:

---

On Error Resume Next
Do While Dateiname <> ""
    Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1, 1, 1, 0)
    BlockDef.Update
    '##--wie kann ich hier noch einstellen, so das der Attributstexte
    '##--nicht angezeigt werden?
   
    BlockDef.GetBoundingBox Min, Max

    Me.Caption = Dateiname
    '##--Virtuellen Stil auf 2D-Drahtkörper einsellen
    ThisDrawing.SendCommand ("_vscurrent" & vbCr & "2d" & vbCr)
    ThisDrawing.Regen acActiveViewport
    ThisDrawing.PurgeAll
    ZoomExtents

    Set Sset = ThisDrawing.SelectionSets("MyBlock")
    Sset.Select acSelectionSetCrossing, Min, Max

    DoEvents
    ThisDrawing.Wblock ExportPfad & Dateiname, Sset
    BlockDef.Delete
    Sset.Delete

    '--Fortschrittsbalken um 1 erhöhen.
    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop

NewDoc.Close
Me.Caption = "Durchlauf beendet"
ProgressBar1.Value = 0

    Exit Sub
MyErrorHandler:
    MsgBox "Es wurde kein Verzeichnis ausgewählt", 64, "Hinweis"
End Sub

---

Vielen Dank im voraus.

Gruß

Dirk

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

---

Hi Dirk, 

Habe gerade kein AutoCAD zur Hand, aber schau mal in der Hilfe nach Shademode.

Gruß, Carsten

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

---

Hallo zusammen!

Ein frohes neues Jahr wünsche ich allen.
Viel Erfolgt, aber vorallem Gesundheit für das Jahr 2010.

Bzgl. Block laden, verarbeiten und als WBlock wieder abspeichern
läuft soweit.

Code:

---

Private Sub cmdDurchlauf_Click()

'--Neue Zeichnung öffnen und die Hintergrundfarbe auf weiß stellen-----------
Dim NewDoc As AcadDocument
Set NewDoc = ThisDrawing.Application.Documents.Add

'--Fehlerbehandlung wenn kein Eintrag in der TextBox------------------------
If TextBox1.Text = "" Then GoTo MyErrorHandler

'--Variablen für Verzeichnis / Dateiauswahl---------------------------------
Dim Dateiname As String
Dim ImportPfad As String
Dim ExportPfad As String

'--Variablen für die Blockbehandlung----------------------------------------
Dim NewBlock As AcadBlock
Dim BlockDef As AcadBlockReference

'--Variablen Allgemein------------------------------------------------------
Dim InsPkt(2) As Double
InsPkt(0) = 0: InsPkt(1) = 0: InsPkt(2) = 0

'--Auswahlsatz festlegen-----------------------------------------------------
Dim Sset As AcadSelectionSet

'--ImportPfad und ExportPfad festlegen---------------------------------------
ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis über Ordnerauswahldialog
ExportPfad = TextBox2.Value & "\" 'Das Verzeichnis über Ordnerauswahldialog

'--Anzahl Dateien ermitteln für Maximale Anzahl im Fortschrittsbalken--------
  Dim DateiZahl As String, I As Integer
  I = 0
  DateiZahl = Dir$(ImportPfad & "*.dwg")
  Do While DateiZahl <> ""
  I = I + 1
  DateiZahl = Dir$()
  Loop
  Me.ProgressBar1.Max = I
 
Dateiname = Dir$(ImportPfad & "*.dwg")
Do While Dateiname <> ""
    Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1#, 1#, 1#, 0)
    BlockDef.Update
   
    Set NewBlock = ThisDrawing.Blocks(BlockDef.Name)
    NewBlock.Name = BlockDef.Name
    NewBlock.Name = Replace(NewBlock.Name, ".", "_")
   
   
    DoEvents
    Me.Caption = Dateiname
    '##--Virtuellen Stil auf 2D-Drahtkörper einsellen
    ThisDrawing.SendCommand ("_shademode" & vbCr & "2d" & vbCr)
    ThisDrawing.Regen acActiveViewport
    ThisDrawing.PurgeAll
    ZoomExtents
   
    On Error Resume Next
    Set Sset = ThisDrawing.SelectionSets("Block")
    If Err.Number Then
        Set Sset = ThisDrawing.SelectionSets.Add("Block")
    End If
    On Error GoTo 0
   
    Sset.Select acSelectionSetAll

    DoEvents
'    ThisDrawing.Wblock ExportPfad & Left(NewBlock.Name, Len(NewBlock.Name) - 4), Sset
    ThisDrawing.Wblock ExportPfad & NewBlock.Name, Sset
   
    BlockDef.Delete
    Sset.Delete

    '--Fortschrittsbalken um 1 erhöhen.
    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop

NewDoc.Close
Me.Caption = "Durchlauf beendet"
ProgressBar1.Value = 0

    Exit Sub
MyErrorHandler:
    MsgBox "Es wurde kein Verzeichnis ausgewählt", 64, "Hinweis"
End Sub

---

Lade ich aber nun solch einen Block in eine Zeichnung, bekomme ich folgende Meldung:

Befehl: _insert
Block BTG_KEIL_OSTEZA_VN_S referenziert sich selbst
*Ungültig*

Im Forum habe ich schon nach einer Lösung dazu gestöbert, aber leider noch nichts passendes gefunden.

Könnte mir da jemand weiterhelfen?
Was müßte ich in dem Code wie ändern, oder ergänzen?

Vielen Dank im voraus.

Gruß

Dirk

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

---

Deine dwg heißt BTG_KEIL_OSTEZA_VN_S  und die enthält einen Block BTG_KEIL_OSTEZA_VN_S  ... soweit so gut ... willst du diese DWG dann aber in eine andere Zeichnung als Block einfügen , würden in der Zeichnung ja 2 Blockdefinitionen BTG_KEIL_OSTEZA_VN_S  enthalten sein .. das geht nicht !!! ( da der Blockname zur eindeutigen Identifizierung dient )

------------------
  - Thomas -          
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo zusammen!

@Alfred:
Ich hätte hierzu noch mal ne Frage.
>>>Ist die zu öffnende Zeichnung selbst eine Blockdefinition (mit dynamischen Eigenschaften), dann ist der Weg allerdings zu überdenken, denn dann folgt von AutoCAD die Abfrage 'wollen Sie diese Zeichnung im Blockeditor öffnen?'<<<

An dieser Stelle unterbricht ja das Programm, weil die besagte Dialogbox erscheint.

Code:

---

...
Do While Dateiname <> ""
    Set tAcadDoc = tAcadApp.Documents.Open(ImportPfad & Dateiname)

'###Hier kommt die Dialogbox
...

---

Die Dialogbox steht ja im Vordergrund.
Greife ich hier manuel mit der Tab - Taste (Ok zu Nein) und drücke dann die Entertaste, läuft das Programm ja weiter.

Dieses könnte man ja auch in einem Programmablauf simulieren

Code:

---

Private Declare Sub keybd_event Lib "USER32.DLL" ( _
  ByVal bVk As Byte, _
  ByVal bScan As Byte, _
  ByVal dwFlags As Long, _
  ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2    'Taste wird losgelassen
Private Const VK_TAB = &H9            'Tab Taste
Private Const VK_RETURN = &HD          'Enter Taste
...
...
Private Sub Tab_Taste_Click()
    keybd_event VK_TAB, 1&, 0&, 0&
    keybd_event VK_TAB, 0&, KEYEVENTF_KEYUP, 0&
End Sub

Private Sub Enter_Taste_Click()
    keybd_event VK_RETURN, 0&, 0&, 0&
    keybd_event VK_RETURN, 0&, KEYEVENTF_KEYUP, 0&
End Sub

...
...
Do While Dateiname <> ""
    Set tAcadDoc = tAcadApp.Documents.Open(ImportPfad & Dateiname)
   
'###Hier kommt die Dialogbox
'###Daher kommt es nicht zu den Call's

Call Tab_Taste_Click
Call Enter_Taste_Click
...

---

Könnte man das noch irgendwie abfange, so das die Call's ausgeführt
werden?
Das wa nochmal ne Idee zu dem Thema, oder würde das gar nicht funktionieren?

Gruß

Dirk

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

---

Hi Dirk,

nur weil Du mich mittels @Alfred direkt angesprochen hast :

Hab mich immer von Win-Calls ferngehalten und kann daher leider für eine hilfreiche Antwort hier mangels Wissen (und Zeit, mir jetzt dieses anzueignen) nicht zur Seite stehen. 

Die Variante von Einfügen der Zeichnung halte ich nach wie vor für die bessere Version!

Viel Erfolg jedenfalls, - alfred -

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

---

hallo miternander

ich hatte ähnliches auch vorgehabt nur noch umfangreicher und bin bei meiner suche auf des tool SmartPurger 2.8 by JTB WORLD gestoßen
vieleicht is das ja auch was

gruß björn 

p.s. ich hab jetzt mal kein link gesetzt nicht das es dann heist ich würde hier werbung machen   

------------------
Wenn Arbeit etwas schoenes und erfreuliches waere,
haetten die Reichen sie nicht den Armen ueberlassen.
[Paul Lafargue]

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