| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| Request a special discount on NVIDIA RTX 5000 Ada Generation GPU !, eine Pressemitteilung
|
Autor
|
Thema: Blockvoransicht (5784 mal gelesen)
|
WolfgangSCH Mitglied
Beiträge: 145 Registriert: 01.10.2002
|
erstellt am: 19. Aug. 2005 13:48 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich möchte mit VB ein Formular erstellen, in dem ich von einer geöffneten AutoCAD-DWG aus einen Ordner mit Blöcken auswählen und dann daraus einen Block wählen kann, der dann in einem Vorschaufenster angezeigt wird (Vorschau). Wenn es der richtige Block ist soll dieser in die DWG eingefügt werden. Wie dies über das WMF-Format funktioniert, habe ich schon in diesem Forum weiter unten lesen können. Jetzt meine Frage: AutoCAD speichert doch selbst ein Dia von jeder Zeichnung in die DWG-Datei ab. Kann man nicht dieses Dia selbst auslesen, wie z.B. bei der Auswahl einer DWG in AutoCAD (Datei öffnen)? Hier wird doch auch eine Vorschau angezeigt! Wie kann ich diese Vorschau mit dem Dia realisieren? Vielen Dank vorab für Eure Hilfe. mfg Wolfgang [Diese Nachricht wurde von WolfgangSCH am 19. Aug. 2005 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
mapcar Mitglied CADmin
Beiträge: 1250 Registriert: 20.05.2002 Die Phönizier haben das Geld erfunden - aber warum so wenig? (Johann Nepomuk Nestroy)
|
erstellt am: 19. Aug. 2005 18:39 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Ob das so direkt wohl geht? Ich glaube nicht - jedenfalls gibt es (genau wie in deinem anderen Posting) keine ActiveX-Methode dafür. Und wieder mal: In Lisp bestehen da bessere Möglichkeiten, die Previews hängen mit GC 310 im BLOCK_RECORD eines Inserts. Da sind sie mir schon öfters begegnet. Vermutlich findet sich dann auch am BLOCK_RECORD des *modelspace* ein solcher 310er, der dann das Prieview des Modellbereichs enthält. Wie die Binärdaten dann aber zu interpretieren sind, ist noch eine ganz andere Frage. Ich habe das nie ausprobiert, aber ich vermute, dass es sich um ein DIB handelt. Daraus könnte man ein BMP bauen, wenn man sich a) die Palette baut, die sollte den ACI-Farbraum enthalten, und dann noch den BMP-Header davorklebt. Aber noch mal deutlich: Viele Wenns und Abers! Vermutlich DIB, vermutlich 256 Farben, und in VBA sowieso nicht, wenn, dann nur in Lisp - und da besteht das Problem, dass Lisp nativ keine Binärdaten lesen/schreiben kann, da braucht man noch einen Teil in C/C++ dazu. Kann aber auch sein, dass ich was übersehe... Irgendwo hab ich auch mal was davon gelesen, dass man über das Designcenter was programmieren kann, aber das habe ich nie versucht. Gibt es so etwas wie eine "Designcenter.tlb", die die COM-Methoden rausreicht? Vielleicht weiss da jemand anders mehr. Gruß, Axel Strube-Zettler ------------------ Meine AutoLisp-Seiten Mein Angriff auf dein Zwerchfell Mein Lexikon der Fotografie Mein gereimtes Gesülze Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WolfgangSCH Mitglied
Beiträge: 145 Registriert: 01.10.2002
|
erstellt am: 23. Aug. 2005 08:02 <-- editieren / zitieren --> Unities abgeben:
|
JoeG Mitglied Systemadmin NX und Autocad
Beiträge: 122 Registriert: 18.10.2002 Autocad 2000 und Win2000
|
erstellt am: 26. Aug. 2005 07:40 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 27. Aug. 2005 17:48 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Wolfgang, wie in anderen Beiträgen schon ausführlich diskutiert das Thema Blockvoransicht. Wenn die Blöcke schon in der Zeichnung sind kann man das doch über die Werkzugpaletten (ab 2004) lösen. Wenn die Blöcke auf der Platte schlummern und z.B. durch ein Tool mitgeliefert werden, kann man schon die Variante mit WMF oder BMP nehmen. Es ist für den Anwender ein wenig Arbeit die Blöcke zu erstellen. Die WMF kann man automatisiert erstellen. Dazu ein Beispiel: Code:
Private Sub CommandButton1_Click() Dim aktWinState As Integer Dim aktHeight As Long Dim aktWidth As Long Dim insPkt(0 To 2) As Double Dim BlockDef As AcadBlock Dim BlockName As String Dim MinPkt(0 To 2) As Double Dim MaxPkt(0 To 2) As Double Dim SelSet As AcadSelectionSet ' Muss Array sein für SelSet Dim BlockSel(0) As AcadEntity' Fenster merken aktWinState = ThisDrawing.WindowState ' Fenster klein einstellen ThisDrawing.WindowState = acNorm ThisDrawing.Width = 400 ThisDrawing.Height = 400 ' Selectionset anlegen On Error Resume Next Err.Clear Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT") If Err.Number <> 0 Then ' Falls vorhanden On Error GoTo 0 Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT") End If On Error GoTo 0 ' Alle Blockdefinitionen durchlaufen For Each BlockDef In ThisDrawing.Blocks If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then BlockName = BlockDef.Name Me.Caption = BlockName ' Blockeinfügen und auf Array setzen Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0) ' Block sichtbar machen BlockSel(0).Update ' Auf Grenzen zoomen ThisDrawing.Application.ZoomExtents ' Ausschnitt vergrößern ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative ' Selektionset leeren SelSet.Clear ' Block dem Seletionset zufügen SelSet.AddItems BlockSel ' WMF exportieren ThisDrawing.Export "C:\Temp\" & BlockName, "wmf", SelSet ThisDrawing.Export "C:\Temp\" & BlockName, "bmp", SelSet ThisDrawing.Export "C:\Temp\" & BlockName, "dxf", SelSet ' Blockreferenz wieder löschen BlockSel(0).Delete End If Next BlockDef Me.Caption = "Fertig" ThisDrawing.WindowState = aktWinState ThisDrawing.Regen acAllViewports End Sub
Vielleicht hilfts dir oder Dirk.B weiter. Stelli1 [Diese Nachricht wurde von Stelli1 am 27. Aug. 2005 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
WolfgangSCH Mitglied
Beiträge: 145 Registriert: 01.10.2002
|
erstellt am: 01. Sep. 2005 16:50 <-- editieren / zitieren --> Unities abgeben:
Hallo Joe, DwgThumbnail.ocx funktioniert wie in einem Beitrag beschrieben nur bis Version 2004. Ich werde daher wohl den Umweg über BMP's wählen. Stelli danke auch Dir für den Tipp! Gruß Wolfgang Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 12. Nov. 2005 16:02 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Stelli1! Das mit dem automatisch erzeugen von wmf's von Blöcken aus einer Zeichnung hört sich gut an. Ich habe meine Blöcke in verschiedenen Verzeichnisordnern liegen z.B. "C:\ACAD\Bloecke\Beschlaege". Könnte man das Programm so umschreiben, daß alle dwg's aus solch einem Ordner automatisch nacheinander geladen und als wmf und oder bmp wieder zurückgeschrieben werden? Und wie immer, wenn ja dann wie? Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 13. Nov. 2005 19:22 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Dirk, sollte doch kein Problem sein. Liest du ab einem Startverzeichnis alles DWG rekursiv durch und wendest die Funktion an. Die Dateien kannst du über das Filesystem Objekt ermitteln oder mit der Funktion DIR. Übrigens ist in deiner DVB der Fehler so:
Code:
' Bei dir etwa so Datei = dir("C:\TEMP\*.WMF" While not Datei ="" ' Die Rückgabe von Dir ist nur der Dateiname ' Beim Öffnen fehlt dir der Pfad msgbox Datei Datei =Dir wend' besser Pfad = "C:\Temp\" Datei = dir(Pfad &"*.WMF" While not Datei ="" ' Die Rückgabe von Dir ist nur der Dateiname ' Beim Öffnen musst du den Pfad angeben !!! msgbox Pfad & Datei Datei =Dir wend
Stelli ------------------ Warum lisp'eln wenn's auch anders geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 07. Mrz. 2007 12:58 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Stelli! Hallo zusammen! Es ist schon ein wenig her mit diesem Thema, aber ich möchte es nochmal aufgreifen. Die Blöcke aus der aktuellen Zeichnung durchlaufen lassen funktioniert gut. Was ich aber nicht hinbekomme, ist die Blöcke aus einem Verzeichnis aus- einlesen und als WMF oder BMP wieder abzuspeichern bzw. zu exportieren. Das Verzeichnis lautet z.B. C:\Temp
Kannst Du / Ihr mir da detailierter mit einem Code helfen? Klasse wäre es, wenn man nun auch noch die Möglichkeit hätte, das nach dem laden des Blocks diesem an dem Einfügebunkt ein roter Punkt angehangen wird. Diese wird dann als WMF oder BMP gespeiert, aber nicht in dem Block selber. Für Hilfe zu dem ersten Punkt wäre ich Euch schon sehr dankbar. mfg. Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 07. Mrz. 2007 16:33 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Wo genau hast denn noch ein Problem?! Beim Öffnen der einzelnen Zeichnungen im Verzeichnis?! Normalerweise würde ich sagen, das du das am besten mit ObjectDBX lösen könntest, allerdings unterstützt dies keine Selectionset, damit funktioniert auch der Export als WMF nicht (Da dort ein Selectionset benötigt wird). Poste mal deinen Ansatz und dann schauen wir weiter. Gruß, Carsten
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 08. Mrz. 2007 13:12 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Carsten! Mit der Vorgabe von Stelli1 bzgl. Blöcke aus der aktuellen Zeichnung lesen und als wmf exportieren komme ich soweit klar, daß funktioniert auch. Mein Problem ist einfach, daß ich nicht weiß bzw. hinbekomme dieses auf ein Verzeichnis mit Zeichnungen anzuwenden. Vom Prinzip her soll es ja wie bei dem Zeichnungsdurchlauf funktionieren. Ich drücke auf einen Button und alle Zeichnung in dem zuvor ausgewählten Verzeichnis werden geladen und als wmf exportiert. Hier das, was ich bislang habe: Code:
Option Explicit Dim oFolder As ObjectPrivate Sub CommandButton2_Click() Dim oShell As Object ' Dim oFolder As Object Set oShell = CreateObject("Shell.Application") Set oFolder = oShell.BrowseForFolder(0, "Bitte einen Ordner auswählen", 1) If Not oFolder Is Nothing Then TextBox1.Value = oFolder.Self.Path End If End Sub Private Sub CommandButton1_Click() 'Dim fPath As String Dim aktWinState As Integer Dim aktHeight As Long Dim aktWidth As Long Dim insPkt(0 To 2) As Double Dim BlockDef As AcadBlock Dim BlockName As String Dim MinPkt(0 To 2) As Double Dim MaxPkt(0 To 2) As Double Dim SelSet As AcadSelectionSet ' Muss Array sein für SelSet Dim BlockSel(0) As AcadEntity ' Fenster merken aktWinState = ThisDrawing.WindowState ' Fenster klein einstellen ThisDrawing.WindowState = acNorm ThisDrawing.Width = 400 ThisDrawing.Height = 400 ' Selectionset anlegen On Error Resume Next Err.Clear 'fPath = TextBox1.Value Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT") If Err.Number <> 0 Then ' Falls vorhanden On Error GoTo 0 Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT") End If On Error GoTo 0 ' Alle Blockdefinitionen durchlaufen For Each BlockDef In ThisDrawing.Blocks If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then BlockName = BlockDef.Name Me.Caption = BlockName ' Blockeinfügen und auf Array setzen Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0) ' Block sichtbar machen BlockSel(0).Update ' Auf Grenzen zoomen ThisDrawing.Application.ZoomExtents ' Ausschnitt vergrößern ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative ' Selektionset leeren SelSet.Clear ' Block dem Seletionset zufügen SelSet.AddItems BlockSel ' WMF exportieren ' ThisDrawing.Export "C:\Temp\" & BlockName, "wmf", SelSet ' ThisDrawing.Export "C:\Temp\" & BlockName, "bmp", SelSet ' ThisDrawing.Export "C:\Temp\" & BlockName, "dxf", SelSet ThisDrawing.Export oFolder.Self.Path & "/" & BlockName, "wmf", SelSet ' Blockreferenz wieder löschen BlockSel(0).Delete End If Next BlockDef Me.Caption = "Fertig" ThisDrawing.WindowState = aktWinState ThisDrawing.Regen acAllViewports End Sub
Für Deine / Eure Hilfe schon mal vielen Dank im voraus. Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 09. Mrz. 2007 07:56 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Du hast doch alles in den Beiträgen stehen, was du brauchst. Im Beitrag von Stelli steht, wie du das Verzeichnis rekursiv durchlaufen kannst. Den Pfad bekommst du ja aus deiner Pfad-Funktion. Dann öffnest du die Zeichnung und lässt deine Block-Funktion durchlaufen, danach kannst du die Zeichnung wieder schließen und die nächste öffnen usw. . Das sollte doch kein Problem sein, oder?! Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 09. Mrz. 2007 10:46 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Carsten! Ich benötige doch noch Deine / Eure Hilfe dazu. Die Zeichnungen mit "dir" auslesen und in einer Msgbox anzeigen lassen bekomme ich noch hin: Code:
Private Sub CommandButton4_Click() Dim Test As String Test = Dir(oFolder.Self.Path & "\" & "*.dwg") While Not Test = "" MsgBox Test Test = Dir Wend End Sub
Dieses aber nun umzusetzen um die Zeichnungen zu laden und als wmf zu exportieren klappt überhaupt nicht. Hier mein Hickhack. Für Dich zum schmunzeln!!!!!! Code:
Private Sub CommandButton4_Click() Dim Test As String Dim insPkt1(0 To 2) As Double Dim BlockDef1 As AcadBlock Dim SelSet1 As AcadSelectionSet Dim BlockSel1(0) As AcadEntityTest = Dir(oFolder.Self.Path & "\" & "*.dwg") ' Selectionset anlegen On Error Resume Next Err.Clear 'fPath = TextBox1.Value Set SelSet1 = ThisDrawing.SelectionSets.Add("WMF_EXPORT") If Err.Number <> 0 Then ' Falls vorhanden On Error GoTo 0 Set SelSet1 = ThisDrawing.SelectionSets("WMF_EXPORT") End If On Error GoTo 0 While Not Test = "" If Not (BlockDef1.IsLayout Or BlockDef1.IsXRef) Then 'Test = BlockDef1.Name 'Me.Caption = BlockName ' Blockeinfügen und auf Array setzen Set BlockSel1(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt1, Test, 1, 1, 1, 0) ' Block sichtbar machen BlockSel1(0).Update ' Auf Grenzen zoomen ThisDrawing.Application.ZoomExtents ' Ausschnitt vergrößern ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative ' Selektionset leeren SelSet1.Clear ' Block dem Seletionset zufügen SelSet1.AddItems BlockSel1 ' WMF exportieren ThisDrawing.Export oFolder.Self.Path & "\" & Test, "wmf", SelSet1 ' Blockreferenz wieder löschen BlockSel1(0).Delete End If Test = Dir Wend End Sub
Für Hilfe, wie der Code tatsächlich lauten sollte, wäre ich wie immer dankbar. Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 09. Mrz. 2007 10:59 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Dirk, irgendwie kommt mir dein Code bekannt vor. Keine Ahnung wo das Problem liegt. Da du ja immer so grosszügig U's verteilst hier mal ein Ansatz der alle Dateien aus einem Verzeichnis liest und alle Blöcke jeder einzelnen Zeichnung nacheinander in eine leere Zeichnung kopiert und anzeigt. Als Einfügepunkt Markierung ist ein Kreis mit drin. Das kann dann vielleicht auch jemand brauchen der aus einer beliebigen Zeichnung einen Block, ein Layout oder so was in die aktuelle Zeichnung einfügen möchte. Ich glaube so ähnlich hast du es dir gedacht. Du musst nur noch den reinen Export nach WMF einbauen. Vorausetzung ist eine leere Zeichnung und der Verweis auf ObjektDBX.
Code: Sub BLOCKS2WMF() Dim Pfad As String Dim CopyBlock As AcadBlock Dim BlockDef As AcadBlock Dim ShowBlock As AcadBlockReference Dim Kreis As AcadCircle Dim axDoc As New AxDbDocument Dim BlockCol(0) As Object Dim insPkt(0 To 2) As Double Pfad = "D:\Daten_Pz\" ' Markierung am Einfügepunkt Set Kreis = ThisDrawing.ModelSpace.AddCircle(insPkt, 0.1) Kreis.color = acRed Kreis.Update Dateiname = Dir(Pfad & "*.dwg") While Dateiname <> "" ' Zeichnung im Hintergrund öffnen Set axDoc = New AxDbDocument axDoc.Open (Pfad & Dateiname) ' Blocks dieser Zeichnung durchsuchen For Each CopyBlock In axDoc.Blocks ' Wenn "richtiger" Block If Not CopyBlock.IsLayout And Not CopyBlock.IsXRef And Not Left(CopyBlock.Name, 1) = "*" Then ' Blockdefinition auf Collection Set BlockCol(0) = CopyBlock ' Block in die aktuelle leere Zeichnung kopieren axDoc.CopyObjects BlockCol, ThisDrawing.ModelSpace ' Blockdefinition holen Set BlockDef = ThisDrawing.Blocks(CopyBlock.Name) ' Block einfügen Set ShowBlock = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockDef.Name, 1, 1, 1, 0) ' Block sichtbar machen ShowBlock.Update '' Block nach WMF ThisDrawing.Application.ZoomExtents ' ..... ' Einfügung löschen ShowBlock.Delete End If Next CopyBlock ' Dokument schliessen Set axDoc = Nothing ' Nächste Datei Dateiname = Dir WendEnd Sub
Stelli ------------------ Warum lisp'eln wenn's auch anders geht. www.ib-stelberg.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 09. Mrz. 2007 12:01 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 09. Mrz. 2007 14:14 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo! Ich nerve, ich weiß, aber ich bekomme es einfach bei mir nicht ans laufen. Entweder verstehe ich von Grund auf den Ablauf bzw. die Zusammenhänge noch nicht, oder ....? Vom Prinzip her sieht es recht einfach aus, ist es wahrscheinlich auch? Ich probiere mal weiter Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 09. Mrz. 2007 14:36 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 09. Mrz. 2007 15:22 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Stelli1 (Wilfried)! Genau das versuche ich auch hinzubekommen. Das mit den Blöcken aus der Zeichnung abspeichern unter wmf in ein zuvor ausgewähltes Verzeichnis funktioniert soweit: Code:
Private Sub CommandButton1_Click() Dim aktWinState As Integer Dim aktHeight As Long Dim aktWidth As Long Dim insPkt(0 To 2) As Double Dim BlockDef As AcadBlock Dim BlockName As String Dim MinPkt(0 To 2) As Double Dim MaxPkt(0 To 2) As Double Dim SelSet As AcadSelectionSet Dim BlockSel(0) As AcadEntity '---Fenster merken aktWinState = ThisDrawing.WindowState '---Fenster klein einstellen ThisDrawing.WindowState = acNorm ThisDrawing.Width = 400 ThisDrawing.Height = 400 '---Selectionset anlegen On Error Resume Next Err.Clear Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT") If Err.Number <> 0 Then '---Falls vorhanden On Error GoTo 0 Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT") End If On Error GoTo 0 '---Alle Blockdefinitionen durchlaufen For Each BlockDef In ThisDrawing.Blocks If Not (BlockDef.IsLayout Or BlockDef.IsXRef) Then BlockName = BlockDef.Name Me.Caption = BlockName '---Blockeinfügen und auf Array setzen Set BlockSel(0) = ThisDrawing.ModelSpace.InsertBlock(insPkt, BlockName, 1, 1, 1, 0) '---Block sichtbar machen BlockSel(0).Update '---Auf Grenzen zoomen ThisDrawing.Application.ZoomExtents '---Ausschnitt vergrößern ThisDrawing.Application.ZoomScaled 0.95, acZoomScaledRelative '---Selektionset leeren SelSet.Clear '---Block dem Seletionset zufügen SelSet.AddItems BlockSel '---WMF exportieren ThisDrawing.Export oFolder.Self.Path & "\" & BlockName, "wmf", SelSet '---Blockreferenz wieder löschen BlockSel(0).Delete End If Next BlockDef Me.Caption = "Fertig" ThisDrawing.WindowState = aktWinState ThisDrawing.Regen acAllViewports End Sub
Das mit dem aus einem Verzeichnis bekomme ich einfach nicht hin, da ich nicht weiß, wie ich diesen aus Deinen Vorgaben richtig zusammenstellen muß. Das mit dem Dim axDoc As New AxDbDocument Set axDoc = New AxDbDocument und Verweis auf ObjektDBX geht das nicht auch mit Dim docObj As New AcadDocument ... Genaugesagt, weiß ich nicht, wie ich in diesem Code das mit dem Dir und dem Export zu wmf realisieren kann. Ich hoffe, Du hast noch nicht die Geduld mit mir verloren? Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 09. Mrz. 2007 15:37 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Dirk, nimm doch mal die letzte Variante (die ganze SUB) von mir und kopiere diese in ein Modul. Unter Extras Verweise wählst du noch den Verweis Autocad/ObjectDBX Common 1xxx aus. Ändere den Pfad "D:\Daten_PZ" in deinen gewünschten Pfad. Dann erstellst du mit Datei/Neu eine leere Zeichnung. Schalte mal den Vollbildmodus des Dokumentes aus und schieb die Größe des Fensters mal ein wenig kleiner. Dann startest du mal die Funktion Blocks2wmf und du siehst alle deine Blöcke aus allen Dateien des gewählten Verzeichnisses wie im Daumenkino in der Anzeige vorbeisausen. Klapp das ? Stelli ------------------ Warum lisp'eln wenn's auch anders geht. www.ib-stelberg.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 09. Mrz. 2007 16:07 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Stelli1! Das funktioniert, nur Zitat:
Dann startest du mal die Funktion Blocks2wmf und du siehst alle deine Blöcke aus allen Dateien des gewählten Verzeichnisses wie im Daumenkino in der Anzeige vorbeisausen.
möchte ich nicht die Blöcke aus den Dateien (Zeichnungen) aus dem Verzeichnis einlesen, sondern die Dateien sind die Blöcke (WBlock). Wie würde das den funktionieren? Mit dem Punkt anhägen ist super. Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 09. Mrz. 2007 16:10 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 09. Mrz. 2007 16:56 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo! Kann man den die einzelnen Dateien (Wblöcke) mit insertBlock einlesen, oder müßte man da evtl. anders ran, mit Zeichnung öffnen, Punkt einfügen und als wmf exportieren und dieses im Durchlauf? Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 09. Mrz. 2007 17:04 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 09. Mrz. 2007 18:28 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Dirk, hatte ich bisher immer anders verstanden. Bei mir sind die Blöcke thematisch zusammengefasst in verschiedenen Prototypenzeichnungen. Vermessung > PZ_VERM.DWG Kanal > PZ_AW_DIN.DWG Da werden die Blöcke bei Bedarf rausgeholt. Hab dir mal ein Beispiel gemacht mit dem es auch mit den Dateien gehen sollte. Bei mir führt aber ZoomExtend nicht immer zum gewünschten Ergebnis weil schon mal ein Einfügepunkt im Abseits liegt. Probier es doch mal aus. (Funktion DWG2WMF) Stelli
------------------ Warum lisp'eln wenn's auch anders geht. www.ib-stelberg.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 10. Mrz. 2007 11:12 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Stelli1! Das funktioniert soweit prima, bis auf das von Dir schon angesprochene Problem mit dem "ZoomExtend" Einfügepunkt. Da es sich ja bei der nun geöffneten Zeichnung nicht um einen Block handelt sondern um die Blockzeichnung ansich, die Frage: Kann man nun das Objekt in der Zeichnung und den eingefügten Kreis zusammenbringen? Wenn ich diese Zeichnung (Block) in eine andere Zeichnung einfüge habe ich ja einen Einfügepunkt den ich mit dem Kreis koppeln kann. Ist dieser Punkt auch in der Zeichnung des Blocks abrufbar? Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 10. Mrz. 2007 19:00 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo! Könnte man so etwas auch hiermit lösen Code:
Dim Entity As AcadEntity Dim TestPkt As Variant ... If Entity.EntityType = acBlockReference Then Set TestBlock = Entity TestPkt = TestBlock.InsertionPoint ...
wenn ja, wie? Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 11. Mrz. 2007 19:02 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Ich muss zugeben, das ich etwas verwirrt bin von deinem vorletzten Beitrag. Willst du die WMFs erstellen und dann soll auch der Kreis in der der (Block-)DWG enthalten sein?! Oder meinst du den Einfügepunkt den du beim einfügen der (Block-)DWG als Externe Referenz erhälst?! Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 11. Mrz. 2007 20:54 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Carsten! Es soll wie folgt ablaufen. - öffnen der Zeichnung (WBlock) - erstellen des Kreises an dem Einfügepunkt des WBlocks - Zoom alles - exportieren nach wmf - Kreis wieder löschen - Zeichnung schließen - nächste Zeichnung usw. Der Kreis soll nur dazu dienen, daß man in dem Bildchen sehen kann, wo der Einfügpunkt liegt. Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 12. Mrz. 2007 06:58 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Das Proggy von Wilfried macht doch genau das, was du willst. In die leere Zeichnung wird dein Block (Einen WBlock gibt es nicht!) als Xref geladen, das Kreis wird beim Einfügepunkt (0,0) des Xrefs eingefügt und das WMF erstellt. Danach wird die Externe Referenz wieder entfernt und die nächste Zeichnung wird bearbeitet. Wo hast du denn da noch dein Problem? Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 13. Mrz. 2007 20:40 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Carsten! Hi Wilfried! Ich glaube, ich habe mich festgefahren. Wenn ich die einzelnen Programme von Dir Wilfried durchlaufen lasse, funktionieren diese soweit prima. Das mit den Zeichnungen öffnen, Kreis einfügen etc. funktioniert, bis auf das, daß das Objekt in der Zeichnung kein Block ist und somit der InsPkt nicht mit dem InsPkt des Kreises übereinstimmt. Eigentlich müßte ich aber doch folgendes erreichen: Eine neue Zeichnung öffnen. In diese Zeichnung sollen nun die Dateien/Zeichnungen aus einem Verzeichnis/Ordner automatisch nacheinander als Block eingefügt werden. Der rote Kreis soll am Insertpoint des Blocks erstellt werden. Danach wird dieses als WMF Datei exportiert und der Kreis wird wieder gelöscht, so wie die Zeichnung. Wie müßte denn dafür der konkrete Code lauten? Vielen Dank im voraus. Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 14. Mrz. 2007 07:01 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Lade doch mal ein, zwei Problem-Blöcke hoch, damit man nachvollziehen kann, wo dein Fehler liegt. Bei klappt das ohne Probleme. Villeicht hast du bei den Zeichnungen ja eine Variable verstellt?! GRuß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Stelli1 Moderator Verm.-Ing.
Beiträge: 1526 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 14. Mrz. 2007 11:57 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Zitat: Original erstellt von Dirk.B: Das mit den Zeichnungen öffnen, Kreis einfügen etc. funktioniert, bis auf das, daß das Objekt in der Zeichnung kein Block ist und somit der InsPkt nicht mit dem InsPkt des Kreises übereinstimmt.
Wenn die Zeichnung eingefügt (oder XREF) wird ist sie ein Block. Vielleicht hast du die Blöcke falsch erzeugt. Mit dem WBLOCK Befehl kannst du ja vorhandene Blöcke oder eine Objektauswahl in eine eigene Datei schreiben. Bei einer Auswahl der Objekte kann leicht der Einfügepunkt verschoben sein. Prüf doch mal in den Zeichnungen ob diese auch wirklich 0,0 als Ursprungspunkt haben. Prüfe auch mal die Variable INSBASE mit der ein anderer Einfügepunkt definiert wird. Zitat: Wie müßte denn dafür der konkrete Code lauten?
Den hast du eigentlich schon. Stelli ------------------ Warum lisp'eln wenn's auch anders geht. www.ib-stelberg.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 19. Mrz. 2007 12:02 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Carsten! Hallo Wilfried! Ich habs mir am Wochenende nochmal vorgenommen und nun hab ich es hinbekommen. So funktioniert es. Code:
Option Explicit Dim oFolder As Object Dim NewDoc As AcadDocument ... ... 'Ordnerauswahl Private Sub CommandButton2_Click() Dim oShell As Object Set oShell = CreateObject("Shell.Application") Set oFolder = oShell.BrowseForFolder(0, "Bitte einen Ordner auswählen", 1) If Not oFolder Is Nothing Then TextBox1.Value = oFolder.Self.Path End If End Sub ... ... 'Erstellung von WMF Dateien aus einem Verzeichnis / Ordner Private Sub CommandButton1_Click() Dim aktWinState As Integer Dim aktHeight As Long Dim aktWidth As Long Dim Dateiname As String Dim ImportPfad As String Dim ExportPfad As String Dim NewBlock As AcadBlock Dim BlockDef As AcadBlockReference Dim Min(2) As Double Dim Max(2) As Double Dim VPKreis As AcadCircle Dim VPschraf As AcadHatch Dim InsPkt(2) As Double Dim Sset As AcadSelectionSet Dim Entity(0) As AcadEntitySet NewDoc = ThisDrawing.Application.Documents.Add ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis wird über Ordnerauswahl in die ExportPfad = ImportPfad ThisDrawing.WindowState = acNorm ThisDrawing.Height = 400 ThisDrawing.Width = 400 Dateiname = Dir(ImportPfad & "*.dwg") While Dateiname <> "" Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1, 1, 1, 0) BlockDef.Update DoEvents Set VPKreis = ThisDrawing.ModelSpace.AddCircle(InsPkt, 2) VPKreis.color = acRed VPKreis.Update Set VPschraf = ThisDrawing.ModelSpace.AddHatch(0, "Solid", True) Set Entity(0) = VPKreis VPschraf.AppendOuterLoop (Entity) VPschraf.color = acRed VPschraf.Update Me.Caption = Dateiname BlockDef.GetBoundingBox Min, Max Application.ZoomExtents ThisDrawing.Regen acActiveViewport On Error Resume Next Set Sset = ThisDrawing.SelectionSets("MySel") If Err.Number Then Set Sset = ThisDrawing.SelectionSets.Add("MySel") End If On Error GoTo 0 Sset.Clear Sset.Select acSelectionSetAll DoEvents ThisDrawing.Export Left(ExportPfad & Dateiname, Len(ExportPfad & Dateiname) - 4), "WMF", Sset BlockDef.Delete VPKreis.Delete VPschraf.Delete Sset.Delete Dateiname = Dir Wend NewDoc.Close Me.Caption = "Durchlauf beendet" End Sub
Nochmals danke für Eure Hilfe. Eins hätte ich aber noch, nur mal so zur optischen Darstellung. Könnte man nun noch einen Fortschrittbalken ProgreßBar einbauen? An welcher Stelle müßte man dieses umsetzen und wie müßte der Code lauten? Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 19. Mrz. 2007 12:52 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Das mit dem Progressbar sollte klappen. Dafür solltest du aber mal deine .DVB hochladen, damit man sich nicht erst was zurechtbasteln muss um zu testen, obs Fehlerfrei ist. Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 19. Mrz. 2007 13:36 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 19. Mrz. 2007 14:50 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Bau es doch einfach so ein: Code: '-------------------------------------------------------------------------------------------- 'Erstellung von WMF Dateien aus einem Verzeichnis / Ordner Private Sub CommandButton1_Click() Dim aktWinState As Integer Dim aktHeight As Long Dim aktWidth As Long Dim Dateiname As String Dim ImportPfad As String Dim ExportPfad As String Dim NewBlock As AcadBlock Dim BlockDef As AcadBlockReference Dim Min(2) As Double Dim Max(2) As Double Dim VPKreis As AcadCircle Dim VPschraf As AcadHatch Dim InsPkt(2) As Double Dim Sset As AcadSelectionSet Dim Entity(0) As AcadEntitySet NewDoc = ThisDrawing.Application.Documents.Add ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis wird über Ordnerauswahl in die ExportPfad = ImportPfad ThisDrawing.WindowState = acNorm ThisDrawing.Height = 400 ThisDrawing.Width = 400 Dateiname = Dir(ImportPfad & "*.dwg") Do While Dateiname <> "" Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & Dateiname, 1, 1, 1, 0) BlockDef.Update 'Markierung am Einfügepunkt DoEvents Set VPKreis = ThisDrawing.ModelSpace.AddCircle(InsPkt, 2) VPKreis.color = acRed VPKreis.Update Set VPschraf = ThisDrawing.ModelSpace.AddHatch(0, "Solid", True) Set Entity(0) = VPKreis VPschraf.AppendOuterLoop (Entity) VPschraf.color = acRed VPschraf.Update Me.Caption = Dateiname
BlockDef.GetBoundingBox Min, Max Application.ZoomExtents ThisDrawing.Regen acActiveViewport On Error Resume Next Set Sset = ThisDrawing.SelectionSets("MySel") If Err.Number Then Set Sset = ThisDrawing.SelectionSets.Add("MySel") End If On Error GoTo 0 Sset.Clear Sset.Select acSelectionSetAll DoEvents ThisDrawing.Export Left(ExportPfad & Dateiname, Len(ExportPfad & Dateiname) - 4), "WMF", Sset BlockDef.Delete VPKreis.Delete VPschraf.Delete Sset.Delete Dateiname = Dir If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do ProgressBar1 = ProgressBar1 + 1 DoEvents Loop NewDoc.Close Me.Caption = "Durchlauf beendet" End Sub
[Diese Nachricht wurde von Carsten1210 am 19. Mrz. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 20. Mrz. 2007 15:02 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Carsten! Danke, daß funktioniert soweit gut. Der Balken läuft jedoch nur ein Stück weit. Ich denke es liegt an den Vorgabewerten "1". Setze ich den Wert höher, läuft zwar der Balken durch, aber es werden nicht mehr alle DWG's zu WMF's erzeugt. z.B. von 7 DWG's nur 2 WMF's. Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 20. Mrz. 2007 15:42 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Ich habs mit 29 Dateien getestet. Bei läufts ohne Probleme durch. Anbei noch mal die .DVB, wo auch vorher die Anzahl der Dateien im Verzeichnis ermittelt werden, damit der Fortschrittsbalken auch passend bis zum Ende läuft. BTW.: Mein Angebot steht noch. Gruß, Carsten
[Diese Nachricht wurde von Carsten1210 am 20. Mrz. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 20. Mrz. 2007 20:49 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002 AutoCAD ACA 2018 Solidworks 2016 Sp5 Enterprise PDM 2016 Sp5 Pascam Woodworks Visual Studio 2017 Pro Windows 10 64Bit Dell T3620 Intel Core i7-7700K 16 GB Arbeitsspeicher 2x Samsung S24C650 Dell M4800
|
erstellt am: 21. Mrz. 2007 14:09 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Hierzu ist mir noch was aufgefallen: Zitat: Der Balken läuft jedoch nur ein Stück weit. Ich denke es liegt an den Vorgabewerten "1". Setze ich den Wert höher, läuft zwar der Balken durch, aber es werden nicht mehr alle DWG's zu WMF's erzeugt. z.B. von 7 DWG's nur 2 WMF's.
In der Schleife zum erhöhen des Fortschrittbalkens ist ja eine exit do Anweisung enthalten. Da liegt dein Fehler. Sobald der Balken am Ende ist, beendet es dein Makro. Dabei ist es egal, ob noch Dateien zum verabeiten vorhanden sind. Wenn weniger Dateien vorhanden sind, als dein Maximalwert(in verbindung mit dem Wert des Hochzählens), wird der Fortschrittsbalken nicht bis zum Ende durchlaufen. Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003
|
erstellt am: 26. Mrz. 2007 09:36 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Carsten! Hallo Wilfried! Ich hatte am Wochenende, trotz des relativ schönen Wetters bei uns, etwas Zeit nochmal alles in Ruhe durchzugehen. Jetzt läuft alles so wie ich es gerne haben wollte, natürlich dank Eurer Hilfe. Gruß Dirk
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 01. Apr. 2007 10:05 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo zusammen! Mein Problem ist folgendes. Ich habe eine UserForm1, hinter der sich mein eigentlicher Programmcode verbiergt bzw. abläuft. Wenn die Schleife Do While durchläuft
Code:
Dim DateiZahl As String, i As Integer i = 0 DateiZahl = Dir$(ImportPfad & "*.dwg") Do While DateiZahl <> "" i = i + 1 DateiZahl = Dir$() Loop UserForm2.ProgressBar1.Max = i UserForm2.ShowDateiname = Dir(ImportPfad & "*.dwg") Do While Dateiname <> "" ... ... Dateiname = Dir If UserForm2.ProgressBar1 + 1 > UserForm2.ProgressBar1.Max Then Exit Do UserForm2.ProgressBar1 = UserForm2.ProgressBar1 + 1 DoEvents Loop ...
soll die UserForm2 auf dem Bildschirm erscheinen, in der der Fortschrittbalken einer ProgressBar abläuft. Wie bekomme ich es hin, die UserForm2 aus der UserForm1 so aufzurufen, daß dieses auch wirklich so funktioniert. Mit dem Programmcode bislang, wird mir zwar die UserForm2 auf dem Bildschirm angezeigt, aber die ProgressBar läuft nicht durch. Hat da jemand eine Lösung für mich? Vielen Dank im voraus. Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 01. Apr. 2007 10:16 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
|
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 01. Apr. 2007 21:11 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi! So funktionierts.
Code:
Dim DateiZahl As String, i As Integer i = 0 DateiZahl = Dir$(ImportPfad & "*.dwg") Do While DateiZahl <> "" i = i + 1 DateiZahl = Dir$() Loop PicLoad.ProgressBar1.Max = i Dateiname = Dir(ImportPfad & "*.dwg") Me.Hide Do While Dateiname <> "" PicLoad.Show False ... ... Dateiname = Dir PicLoad.PicLoadLab.Caption = Dateiname If PicLoad.ProgressBar1 + 1 > PicLoad.ProgressBar1.Max Then Exit Do PicLoad.ProgressBar1 = PicLoad.ProgressBar1 + 1 DoEvents Loop Unload PicLoad NewDoc.Close PicLoad.ProgressBar1.Value = 0 ... Me.Show End Sub
Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 02. Apr. 2007 07:47 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Dirk, Zwei Sachen hab ich noch dazu: 1. Ist ne Geschmackssache: Damit du die Userform mit dem Progressbar modeless(Ungebunden) aufrufen kannst musst du das "Hauptformular" erst ausblenden. Ich finde, das verwirrt den Benutzer nur. Aber das ist, wie gesagt eine Geschmackssache. 2. Hast du dir die Größe der WMFs mal angesehen?! Der Zoom dürfte bei dir nicht funktionierten und die WMFs dürften daher auch nicht annähernd Quadratisch sein. Kannst dir ja die WMFs mal anschauen und mich überzeugen, das es anders ist. Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Dirk.B Mitglied Tischler / Leiter Arbeitsvorbereitung
Beiträge: 534 Registriert: 25.11.2003 AutoCAD 2021/2022 CAD+T HP ZBook 15 G4, 64-bit, WIN 10 Pro
|
erstellt am: 02. Apr. 2007 12:49 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hi Carsten! Zitat:
Zwei Sachen hab ich noch dazu: 1. Ist ne Geschmackssache: Damit du die Userform mit dem Progressbar modeless(Ungebunden) aufrufen kannst musst du das "Hauptformular" erst ausblenden. Ich finde, das verwirrt den Benutzer nur. Aber das ist, wie gesagt eine Geschmackssache. 2. Hast du dir die Größe der WMFs mal angesehen?! Der Zoom dürfte bei dir nicht funktionierten und die WMFs dürften daher auch nicht annähernd Quadratisch sein. Kannst dir ja die WMFs mal anschauen und mich überzeugen, das es anders ist.
Zu Punkt 1. Wie würdest Du es denn machen? Zu Punkt 2. Ich bin mit der Darstellung zufrieden. Schau Dir mal die Bildchen an. Gruß Dirk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Carsten1210 Mitglied staatl. geprüfter Holztechniker
Beiträge: 1358 Registriert: 24.07.2002
|
erstellt am: 02. Apr. 2007 12:56 <-- editieren / zitieren --> Unities abgeben: Nur für WolfgangSCH
Hallo Drik, Zu den Bildchen. Schau mal in die Eigenschaften der WMFs. Die sind nicht Quadratisch, wie es von der Einstellung des Zeichnungsfensters eigentlich sein sollte. Da bekommst du bei größeren Sachen vielleicht ein Problem. Zum Progressbar: Ich würde die Userform1 einfach geöffnet lassen und die Userform mit dem Progressbar darüber einblenden und ablaufen lassen. Dann bekommt der User auch nicht das geflacker beim ablaufen der einzelnen Blöcke im Zeichnungsfenster mit. Gruß, Carsten Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |