| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY präsentiert die neue NVIDIA RTX A400 und die A1000 Grafikkarte, eine Pressemitteilung
|
Autor
|
Thema: automatische Ermittlung der Rahmenabmaße (2108 mal gelesen)
|
juliasmarc Mitglied Student
Beiträge: 10 Registriert: 24.02.2005
|
erstellt am: 24. Feb. 2005 22:24 <-- editieren / zitieren --> Unities abgeben:
Hallo, zu einem wichtigeren Projekt habe ich ca. 700 Pläne erstellen müssen. Nun wurde mir im Nachhinein mitgeteilt, dass für alle Pläne die Abmaße gewünscht sind. Gibt es eine Möglichkeit, bzw. ein kleines Programm, welches die Pläne öffnet und mir die Maße des Rahmens ausliest? Der Rahmen befindet sich natürlich auf einem extra Layer. Ich glaube zwar, dass das ganze nicht in drei Zeilen abgetan ist, aber vielleicht hat ja doch jemand einen Lösungsvorschlag. Dank an alle Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Proxy Ehrenmitglied Stateless-DHCP v6-Paketfragmentierer
Beiträge: 1629 Registriert: 13.11.2003 Tastaturen, Mäuse, Pladden, Monitore, ..., einige AutoCADs 200x & SWX 2kX
|
erstellt am: 25. Feb. 2005 07:29 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
Ist der Rahmen ein Block, Polylinienzug ... einzelne Linien ? Sind die Rahmen immer einzeln im Layoutbereich oder irgendwo im Modellbereich ? Fragen über Fragen ... Als Beispiel BoundingBox eines ssgets. Code:
Sub ad_ssBox() 'This routine gets and shows the bounding box of a selection set. 'Demand load: -vbarun;ad_Utility.dvb!ad_ssBox; Dim adExtMax As Variant, adExtMin As Variant Dim adtmpMax As Variant, adtmpMin As Variant Dim adSS As AcadSelectionSet Dim adEnt As AcadEntity Set adSS = ThisDrawing.SelectionSets.Add("adSS") adSS.SelectOnScreen For Each adEnt In adSS adEnt.GetBoundingBox adExtMin, adExtMax GoTo ExtComp Next adEnt ExtComp: For Each adEnt In adSS adEnt.GetBoundingBox adtmpMin, adtmpMax If adtmpMin(0) < adExtMin(0) Then adExtMin(0) = adtmpMin(0) If adtmpMin(1) < adExtMin(1) Then adExtMin(1) = adtmpMin(1) If adtmpMax(0) > adExtMax(0) Then adExtMax(0) = adtmpMax(0) If adtmpMax(1) > adExtMax(1) Then adExtMax(1) = adtmpMax(1) Next adEnt adSS.Delete MsgBox "Extents for selection set" & vbCr & _ "= " & adExtMin(0) & ", " & adExtMin(1) & " :" _ & vbCr & " " & adExtMax(0) & ", " & adExtMax(1) Dim adLine As AcadLine Dim adStart(0 To 2) As Double Dim adEnd(0 To 2) As Double adStart(0) = adExtMin(0): adStart(1) = adExtMin(1): adStart(2) = 0 adEnd(0) = adExtMax(0): adEnd(1) = adExtMax(1): adEnd(2) = 0 Set adLine = ThisDrawing.ModelSpace.AddLine(adStart, adEnd) End Sub
------------------ "Lisp?!?! Why the Hell did you pick the most arcane, obscure, and hopelessly-rooted-in-the-computer-science-department language in the world for an AutoCAD programming language?" Read the whole story: The Autodesk File ca. 890 Seiten | 7500 KB PDF Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Huebi Mitglied Vermessungsing.
Beiträge: 107 Registriert: 08.01.2004 Intel Core Duo E6750@2.66GHz NVIDIA GeForce 8600 GT AutoCAD 2004, 2007, 2008 AcadMAP 2004 und 2007 Civil 3D 2008 ADT 2009
|
erstellt am: 25. Feb. 2005 07:54 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
Servus Marc, erstmal hallo und herzlich willkommen im Forum! Das was Du suchst - denke ich - ist die Methode "GetBoundingBox", die die Maximalwerte eines AutoCAD Objektes ermittelt. Wenn man das auf einen Auswahlsatz anwendet (hier Alle Objekte im Layer "Rahmen"), kann man sehr einfach die Extremwerte über alle Objekte ermitteln und damit natürlich auch die Gesamtgröße. Hier mal ein kleines Progrämmchen... Code:
Sub GetBoundingBoxByLayer()Dim Min, Max, AllMin, AllMax As Variant Dim RahmenLayer As String Dim AcSSet As AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant RahmenLayer = "Rahmen" 'Auswahlfilter nur auf Layer "Rahmen" setzen FilterType(0) = 8 FilterData(0) = RahmenLayer 'Erstelle Auswahlsatz mit allen Elementen im Layer "Rahmen" On Local Error Resume Next If TypeName(ThisDrawing.SelectionSets("Auswahl")) = "Nothing" Then Set AcSSet = ThisDrawing.SelectionSets.Add("Auswahl") Else Set AcSSet = ThisDrawing.SelectionSets("Auswahl") End If AcSSet.Clear AcSSet.Select acSelectionSetAll, , , FilterType, FilterData 'Schleife durch den Auswahlsatz For i = 0 To AcSSet.Count - 1 'hole maximale Ausmaße des Zeichnungsobjektes AcSSet.Item(i).GetBoundingBox Min, Max 'erstes Element >> AllMin und AllMax initialisieren If i = 0 Then AllMin = Min AllMax = Max Else 'Abfrage ob Maximalgrenzen überschritten werden If Min(0) < AllMin(0) Then AllMin(0) = Min(0) If Min(1) < AllMin(1) Then AllMin(1) = Min(1) If Max(0) > AllMax(0) Then AllMax(0) = Max(0) If Max(1) > AllMax(1) Then AllMax(1) = Max(1) End If Next i MsgBox ("Links unten: X=" & Format(AllMin(0), "0.00") & " Y=" & Format(AllMin(1), "0.00") & vbCr & _ "Rechts oben: X=" & Format(AllMax(0), "0.00") & " Y=" & Format(AllMax(1), "0.00")) End Sub
Ich hoffe, es hat Dir ein wenig weiter geholfen Gruß aus München Hübi ------------------ Schaun ma mal, dann seng ma scho.... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Huebi Mitglied Vermessungsing.
Beiträge: 107 Registriert: 08.01.2004 Intel Core Duo E6750@2.66GHz NVIDIA GeForce 8600 GT AutoCAD 2004, 2007, 2008 AcadMAP 2004 und 2007 Civil 3D 2008 ADT 2009
|
erstellt am: 25. Feb. 2005 07:55 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
|
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 25. Feb. 2005 16:50 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
Hi, hier auch mal noch ein Ansatz, aber ohne eleganten Filter ;-) Die Info's sind echt bissel wenig, wie schon gesagt ... Sowas funzt also nur wenn wirklich nur ein Objekt (der Rahmen) auf Layer "Rahmen" liegt, von Rahmen in Layouts [eigentlich Usus?] red' ich mal garnich ... ;-) Gruss Nancy
Code:
Sub test() Dim i&, p$, f$, min, max p = "d:\cad\pfad\" Open "d:\cad\rahmen.txt" For Output As #1 f = Dir(p & "*.dwg") Do While f <> "" Documents.Open p & f With ActiveDocument.ModelSpace For i = 0 To .Count - 1 If .Item(i).Layer = "Rahmen" Then .Item(i).GetBoundingBox min, max Print #1, ActiveDocument.Name, max(0) - min(0) & " x " & max(1) - min(1) Exit For End If Next End With ActiveDocument.Close 0 f = Dir Loop Close #1 End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 25. Feb. 2005 19:45 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
Hallo nochmal, hab grade mal noch bissle experimentiert mit Filtern und so ... Weiss nicht ob ich nen Denkfehler drinnehab, unten nochmal der Code. Mich würde mal intressieren, ob man - speziell in so einer Konstellation - sowas wie zB. Application.screenupdating=false machen kann oder irgendsowas in der Art, ich mein wenns doch paar mehr *.dwg's sind wäres IMHO hübscher ;-) Oder man startet gar nicht aus Acad sondern aus ner andren Appli und lässt dann einfach AcadApp.Visible=false ??? Gruss Nancy
Code:
Sub nocheintest() Dim sset As AcadSelectionSet Dim ftype%(0), fdata(0) Dim p$, f$ ftype(0) = 8: fdata(0) = "Rahmen" p = "d:\cad\irgendweinpfad\" Open "d:\cad\rahmen.txt" For Output As #1 f = Dir(p & "*.dwg") Do While f <> "" Documents.Open p & f With ActiveDocument On Error Resume Next If IsError(.SelectionSets("myset")) Then Set sset = .SelectionSets.Add("myset") _ Else Set sset = .SelectionSets("myset") On Error GoTo 0 sset.Clear sset.Select acSelectionSetAll, , , ftype, fdata Print #1, .Name, maxbound(sset) .Close 0 End With f = Dir Loop Close #1 End SubFunction maxbound(ParamArray ss()) As String Dim i&, x#, y#, min, max For i = 0 To ss(0).Count - 1 ss(0).Item(i).GetBoundingBox min, max If max(0) - min(0) > x Then x = max(0) - min(0) If max(1) - min(1) > y Then y = max(1) - min(1) Next If x = 0 And y = 0 Then maxbound = "nix gefunden" Else maxbound = Round(x, 2) & " x " & Round(y, 2) End Function
[Diese Nachricht wurde von startrek am 25. Feb. 2005 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
juliasmarc Mitglied Student
Beiträge: 10 Registriert: 24.02.2005
|
erstellt am: 01. Mrz. 2005 13:25 <-- editieren / zitieren --> Unities abgeben:
Hallo, danke für eure schnelle und kompetente Hilfe. Habe mich verschaute, also die Rahmen sind auf Layer 0 und keine Polylinien oder Blöcke Und ich verstehe leider nichts vom programmieren, bin ein reiner Anwender, also leider verstehe ich nur Bahnhof. Wäre toll wenn ihr noch eine Lösung für so jemanden wie mich findet;-) Danke für eine Mühe und viele Grüße
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 02. Mrz. 2005 00:41 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
> Und ich verstehe leider nichts vom programmieren, bin ein reiner Anwender, > also leider verstehe ich nur Bahnhof. Julian, du hast hier im Acad/VBA gepostest, da wird vorrausgessetzt, dass ein Mindestmass an Kenntniss wie man Codefragmente nutzt/einsetzt, vorhanden ist. Im 'Rund um Autocad' wärst vielleicht besser bedient gewesen, weisst nich wie man den codez startet/einfügt oder wo genau drückt denne der Schuh? ;-) Gruss Nancy [Diese Nachricht wurde von startrek am 02. Mrz. 2005 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
juliasmarc Mitglied Student
Beiträge: 10 Registriert: 24.02.2005
|
erstellt am: 04. Mrz. 2005 16:04 <-- editieren / zitieren --> Unities abgeben:
Hallo Nancy, also ich habe hier schon nettere Antworten bekommen. Wenn man sich hier nur anmelden kann, wenn man was vom Programmieren versteht, schreibt das doch hin?! Hatte bis jetzt hier nie Probleme, nicht ein einziges Mal, und es hat sich auch niemand daran gestört, wenn man zugibt keine Ahnung zu haben. Wozu gibt es dann ein Forum? Du hast bestimmt eine super Antwort auf Lager?! Ich gehe mal davon aus, das du es nicht so gemeint hast wie ich es verstanden habe. Also, erstens habe ich nicht verstanden wohin mit dem super Programm, ist ja nicht so das ich es nicht versucht hätte, und zweitens wollte ich noch einmal erwähnen das es sich nicht um einen RAhmenblock oder PolyLinie handelt. Dachte es wäre relevant. Da ich ahne das sich das Problem nicht so einfach lösen läßt, werde ich mich wohl hinsetzen und jeden Plan einzeln aufmachen müssen. Ich bitte noch einmal um Entschuldigung, wenn ich deine Programmierer Ehre mit meinem Unwissen verletzt haben sollte. Wünsche trotz alledem jedem hier Lesenden und Verweilenden ein schönes erholsames Wochenende! Grüße JULIA!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 04. Mrz. 2005 19:13 <-- editieren / zitieren --> Unities abgeben: Nur für juliasmarc
Hi Julia, hoppla, da ist wohl bissle was falsch rübergekommen ..., also ein Rettungsversuch meiner Ehre als Nicht-Programmierer ;-) > Wenn man sich hier nur anmelden kann, > wenn man was vom Programmieren versteht, schreibt das doch hin?! Also das ist Käse ;-) Dass du keine Ahnung von Programmieren hast, is ja nicht schlimm, es ist nur so, in deinem allerersten Post war das nicht unbedingt ersichtlich. Es setzten sich also 3 Leute hin und versuchten dir mögliche Ansätze zu coden, keiner wusste aber, dass du eigentlich garnix mit den Vorschlägen anfangen kannst, - möglicherweise wären die Antworten dann von vornherein anders ausgefallen - weil hier im Acad/VBA-Forum geht man nunmal einfach davon aus, dass der Fragesteller weiss, wie man ein Makro startet bzw. schonmal einen Blick in die _vbaide geworfen hat. Aber nu egal, mache mal folgendes:
*********************** - drücke Alt+F11 unter Acad oder tippe _vbaide in der Befehlszeile, es öffnet sich der Visual Basic Editor [VBE], die Entwicklungsumgebung zu Autocad - im VBE unter Menue Einfügen wählst Du 'Modul' und es erscheint ein leeres Codefenster 'Modul1' - dahinein die Codes kopieren (am besten erstmal nur Proxys und Huebis) - optional kannste die Datei speichern, zB 'test.dvb', test.dvb ist somit auf deiner Platte gespeichert und kann/muss beim nächsten start von Autocad via Werkzeuge/Makros/Projekt laden - nur noch geladen werden, wenn du deren Makros nutzen willst - den VBE kannst jetzt schliessen und erstmal anhand einer einzelnen Bsp-Zeichnung testen, was denn die Makros so machen, also einfach Alt+F8 drücken, es werden alle verfügbaren Sub's gelistet, eine auswählen > ausführen - Anweisungen befolgen und gucken was passiert;-) *********************** Bevor Du meinen Code [den letzten] probierst, lege dir aber am besten irgendwo einen neuen Ordner an, wo du testhalber mal 10 oder 20 der [Rahmen]Zeichnungen reintust. Nun musst Du die zwei Pfade anpassen
Code:
p = "d:\cad\irgendeinpfad\testordner\" '<-- der Pfad zum Ordner, wo die 20 testdwg's drinne liegen Open "d:\cad\irgendeinpfad\testordner\rahmen.txt" For Output As #1 '<-- rahmen.txt wird zB im testordner erstellt
Jetzt mal probieren, Schema wie oben genannt. Nochwas, wenn's denn wie gewünscht tut, würde ich's aber nicht über die 700 dwgs auf einmal laufen lassen, [ich habs einfach nicht probiert mit soo vielen files] sondern vielleicht auf 7x a' 100 aufteilen oder so, halt 7 Order und 7 txt's erstellen, kann aber auch mit 700 funzen, ich weisses einfach nicht ..., bin ja kein Programmierer;-) *********************** Du siehst also, nur weil das Forum Acad/VBA heisst, bekommste deswegen hier: a) noch lange keine fertigen Programme, sondern nur [Denk]Ansätze zum weiterbasteln/ausarbeiten. b) dauert das Erklären im Nachgang manchmal länger als den eigentlichen Code zu schreiben, und nicht jeder, mich eingeschlossen, ist der geborene 'Erklärer' [macht auch nich soviel Spass] ;-))) Last but not least, auf den Schlips treten wollte ich Dir nicht mit meinem Post, nur im Acad-Forum lesen halt viel mehr mit, die vielleicht ein ähnliches Problem schonmal hatten und ggf. mit nem Link oder fertigen Tool [und wenns ne Demo wäre] hätten aushelfen können. jedenfalls egal wie - HTH ;-) Gruss Nancy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|