---

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

---

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

---

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

---

*lach* Proxy war mal wieder schneller (und wohl auch professioneller)... naja, lieber so, als gar keine Antwort *g*

------------------
Schaun ma mal, dann seng ma scho.... 

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

---

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

---

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 Sub

Function 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

---

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

---

> 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

---

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

---

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