| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Geometrie einer Bemassung (2290 mal gelesen)
|
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: 17. Jan. 2005 11:16 <-- editieren / zitieren --> Unities abgeben:
Servus zusammen, evtl. kann mir jemand bei meinem Problem helfen Ich bemaße Gebäudegrundrisse (die ich als Vermesser zuvor aufgemessen habe). Dazu habe ich mir einen Bemaßungsstil definiert, der einen benutzerdefinierten "Pfeil" hat (...also dieser übliche Schrägstrich) und ich unterdrücke die beiden Hilfslinien. Das funktioniert soweit recht gut und das Ergebnis entspricht - bis auf wenige Abstriche - dem, was ich von dieser Bemassung erwarte. Nun mein Problem: Wenn ich beide Hilfslinien unterdrücke, sehe ich die Bezugspunkte der Bemaßung nur als "Pixel". Wenn man die Bemassung selektiert, bekommt man an dieser Stelle auch 2 Griffe und man kann wunderbar die Bezugspunkte (im Bedarfsfall) verschieben. Im Normalfall liegen die Bezugspunkte ja auf einer Linie und die "Pixel" verschwinden sehr schnell im Zeichnungsgewirr. Mein erster Gedanke war der, daß man ja evtl. die Größe der Anzeige der Bezugspunkte in AutoCAD beeinflussen kann - da bin ich aber nicht weiter gekommen. Mein zweiter Gedanke war der, daß ich einen temporären Layer per VBA erzeugen könnte, in dem diese Bezugspunkte (nur zur Visualisierung) als Punkte (incl. eines passenden Punktformates) zu sehen wären. Leider komme ich allerdings an die Geometrie der Bemassung in VBA nicht ran. Ich finde nirgends einen "Start-" oder "Endpoint", mit dem ich neue Punkte erzeugen könnte. Alles was ich nachträglich an einer Bemassung verändern kann sind die (reichlichen) Parameter. Weiß von Euch jemand eine vernünftige Lösung, bzw. kann mir jemand erklären, wie die Geometrie einer Bemaßung in VBA abgerufen werden kann? Vielen Dank schon mal vorab und liebe Grüße aus München Der Hübi
------------------ Wissen ist Macht - nix wissen macht nix! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 17. Jan. 2005 14:57 <-- editieren / zitieren --> Unities abgeben: Nur für Huebi
Hallo, wenn ich dich richtig verstanden habe, möchtest du die Bezugspunkte optisch vervorheben? Stell ich mir gar nicht so einfach vor, mal gesponnen, deinen Ansatz mit dem temporären Layer und Hilfspunkten: Du klapperst deine Bemaßungen ab und fragst deren Boundingbox ab.
Code:
Sub y() Dim bem As AcadEntity, min, max Set bem = ThisDrawing.ModelSpace.Item(1) bem.GetBoundingBox min, max End Sub
Das war ja noch die leichteste Übung ... ;-) Nun müsstest Du aber unterscheiden zwischen dimaligned und dimrotated. Dimaligned wiederrum müssteste prüfen in welche Richtung diese erstellt worden ist, also 4 Möglichkeiten. Zu Rimrotated schweig ich mich vorsichtshalber mal ganz aus ... Und zu guterletzt, deine Dummy-Punkte auf dem Dummy-Layer, was wird mit denen, wenn Du mal die Bezüge deiner Maßketten änderst? Gruss Nancy 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: 17. Jan. 2005 16:25 <-- editieren / zitieren --> Unities abgeben:
Servus Nancy! Ich denke, Du hast schon erfasst, um was es mir geht. Ich möchte nur anzeigen lassen (zu einem fixen Zeitpunkt), wo die Bemaßungsbezugspunkte so liegen. Dummerweise benutze ich nur DimRotated, da die ja am universellsten zu benutzen sind. Das mit dem anzeigen stell ich mir so vor, daß ich ein VBA-Programm starte, dieses Programm dann den Dummy-Layer löscht und die Bezugspunkte "reinmalt". Ob als kleine Kreise oder als AcadPoint - es geht ja nur darum, daß man in dem ganzen, komplexen Grundriss die Bezugspunkte wiederfindet. Wenn sich was ändert, wiederholt sich das einfach. Knopfdruck, alle bisherigen Kreise (oder Punkte) werden gelöscht und neu generiert. Die Sache mit der Boundingbox klingt schon mal ganz interessant, aber bekomm ich denn nirgens mehr in VBA die Bezugspunkte einer Bemassung her? In AutoCAD selbst kann ich sie ja auch ansprechen (z.B. über die Griffe), also müssen sie ja auch irgendwo abgespeichert sein. Ich denke, ich hab sie auch im DXF schon identifizieren können (ich möchte aber nicht den Umweg über eine DXF-Datei machen). Nur in VBA hab ich immer noch keine Möglichkeit gefunden, sie anzugreifen. Vermutlich haben sich die VBA-Macher bei Autodesk was dabei gedacht, damit man nicht zu tief in den Eingeweiden reinpfuschen kann *g*...wer weiß... Anderer Gedankenansatz: Gibt es evtl. eine andere Methode (ala "AppendOuterLoop" bei der Schraffur oder "AddRegion(ObjectList)" bei der Region), die einem Auskunft über die Geometrie der Bemassung geben kann? Ist die Geometrie über eine Liste abrufbar? *amkopfkratz* Liebe Grüße der ratlose Hübi ;-) ------------------ Wissen ist Macht - nix wissen macht nix! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 17. Jan. 2005 17:38 <-- editieren / zitieren --> Unities abgeben: Nur für Huebi
Ratlos? shakehands ;-) Huebi, ich weisses auch nicht ... Fakt ist, wenn Du mal deine Bemaßung mit _explode zerlegst, verschwindet leider auch der kleine pixelige Punkt. Wär ja auch zu schön gewesen, wenn Acad da nen Punkt draus macht ... Also jetzt mal ganz blöde gesponnen, Du würdest Dir deine komplette Bemassung auf nen Dummylayer kopieren. Dann weist Du der Kopie einen Bem-Stil zu, wo: Bem_Linie1 = unterdrückt Bem_Linie2 = unterdrückt über Bem_Linien hinaus erweitern = 0 Abstand vom Ursprung = 0 Dann die Dynamitstange zünden und Du hättest nur noch Texte und [ehem. Hilfs]Linien auf dem Layer. Weiterhin müssteste herausfinden, welche der Linienanfangs- bzw. Endunkte auf einer 'gedachten' Geraden liegen, und genau die Gegenpunkte der jeweiligen Linien wäre dein jeweils gesuchter Ursprung? Ich wöllts aber nicht proggn müssen ... ;-) Wiegesagt, keine weiteren Ideen - ich weiss nicht, was die Lispler da noch in der Trickkiste hätten? Gruss Nancy -- ps: Wenns nur um die Erstellung gänge, könntest Du Dir allenfalls den Bemaßungsbefehl nachbasteln, aber damit wirste auch nicht froh werden ...
Code: Sub ansatz() Dim bem As AcadDimAligned, p As AcadPoint, p1, p2 With ThisDrawing p1 = .Utility.GetPoint(, "Point1") p2 = .Utility.GetPoint(p1, "Point2") Set p = .ModelSpace.AddPoint(p1) Set p = .ModelSpace.AddPoint(p2) Set bem = .ModelSpace.AddDimAligned(p1, p2, p2) Do While MsgBox("weiter?", vbOKCancel) <> vbCancel p1 = p2 p2 = .Utility.GetPoint(p1, "Point2") Set p = .ModelSpace.AddPoint(p2) Set bem = .ModelSpace.AddDimAligned(p1, p2, p2) Loop End With 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: 17. Jan. 2005 18:04 <-- editieren / zitieren --> Unities abgeben: Nur für Huebi
Nochwas ... - komisch die einfachsten Gegenfragen fallen einem immer zu spät ein ;-) ... also, selbst wenn man es 'irgendwie' hinkriegt und da wimmelte es überall von Punkten, wie in Gottes Namen willst Du denn deren Zuordnung zur jeweiligen Maßkette erkennen? ;-) Gruss again, Nancy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TomiProg Mitglied Technischer Zeichner
Beiträge: 51 Registriert: 29.04.2004 WinNT4.0(SP6) + AutoCAD 14.01, P3/400MHz(gääähn),256MB,Graphtec KD4620, ATI 3D Rage Pro(8MB)
|
erstellt am: 18. Jan. 2005 11:44 <-- editieren / zitieren --> Unities abgeben: Nur für Huebi
Hallo zusammen. Hatte mich auch mal intensiv mit Bemaßung beschäftigt. Das ist schon eine seltsame Sache, daß bei einigen Bemaßungsarten keine Start- und Endpunkte über VBA ausgelesen werden können. Das gilt auch für dir gedrehte Bemaßung (RotatedDim) nicht aber für eine ausgerichtete Bemaßung (AlignedDim). Vielleicht bekommst du die gleiche Bemaßung mit der ausgerichteten Bemaßung hin. Dann wären die zwei Punkte für die Extramarkierung leicht zu ermitteln. Warum das nicht bei allen Bemaßungsarten geht muß man wohl die AutoCAD-Programmierer fragen. Ist echt schade, das sowas nicht einheitlich programmiert wird.....
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: 18. Jan. 2005 14:51 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von startrek: Nochwas ... - komisch die einfachsten Gegenfragen fallen einem immer zu spät ein ;-)... also, selbst wenn man es 'irgendwie' hinkriegt und da wimmelte es überall von Punkten, wie in Gottes Namen willst Du denn deren Zuordnung zur jeweiligen Maßkette erkennen? ;-) Gruss again, Nancy
Gute Frage Nancy *g*, also wenn ich weiß, wo die Bezugspunkte liegen und diese nicht (was normal ja der Fall ist) von Linien überdeckt werden, kann ich überprüfen, ob die Maßkette auch da liegt, wo sie hingehört. Kleines Beispiel: Ich verschiebe (korrigiere) nachträglich eine Wand, die dazugehörige Maßkette liegt weit entfernt. Evtl. merke ich nicht, daß eine Maßkette betroffen ist, weil ich den Bezugspunkt nicht sehe. Wenn ich ihn aber sehen kann, dann kann ich die Bezugspunkte der Bemassung (im Normalfall sind ja 2 Bemassungen betroffen) per Griff auf die verschobene Wand korrigieren. Zum besseren Verständnis, habe ich ein kleines JPG angehängt, in dem ich die Bezugspunkte bereits rot eingefärbt habe (ja, ich habe eine Möglichkeit - wenn auch holprig - gefunden). Also dient die ganze Sache ausschließlich der Kontrolle meiner Maßketten. Den Programmcode füge ich als nächste Antwort gleich mit an Gruß vom Hübi ------------------ Wissen ist Macht - nix wissen macht nix! 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: 18. Jan. 2005 14:56 <-- editieren / zitieren --> Unities abgeben:
Servus @ Alle hier also der Programmcode. Ich bin einen Umweg über eine DXF-Datei gegangen, da die Bezugspunkte hier offen (wenn auch in Ihrer Genauigkeit eingeschränkt) liegen. Ich hoffe, der Eine oder Andere kann was damit anfangen Sub Bemassungsmarkierung() Dim DummyLayer As AcadLayer Dim FileName As String Dim ActSSet As AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim Code As Integer Dim CodeStr, Data As String Dim BemAktiv, BemWrite As Boolean Dim BezPkt(3) As Double
' Temporäre DXF-Datei definieren FileName = "f:\tmp\temp"
' Dummylayer für die Markierungen öffnen und alle Elemente darin löschen Set DummyLayer = ThisDrawing.Layers.Add("BemMark") DummyLayer.color = acRed ' Auswahlset erstellen für alle Markierungen im Layer "BemMark" On Local Error Resume Next ThisDrawing.SelectionSets("Dummy").Delete Set ActSSet = ThisDrawing.SelectionSets.Add("Dummy") ActSSet.Clear FilterType(0) = 8 FilterData(0) = "BemMark" ActSSet.Select acSelectionSetAll, , , FilterType, FilterData ' Alle Elemente (von früher) im Layer "BemMark" löschen For i = 0 To ActSSet.Count - 1 ActSSet.Item(i).Delete Next i ' Zeichnung als DXF in eine Dummy-Datei exportieren (leider funktioniert beim ' DXF-Export die Setlectionset-Auswahl nicht, sonst könnte man hier nur die ' Bemassungen ausgeben ActSSet.Clear ThisDrawing.Export FileName, "dxf", ActSSet ' DXF-Datei öffnen und Code und Daten einlesen FileName = FileName & ".dxf" Open FileName For Input As #1 ' Initialisierungen vor der Schleife ' BemAktiv bedeutet, daß momentan eine Bemassung aus der DXF-Datei gelesen wird BemAktiv = False ' BemWrite gibt an, ob die letzte, gelesene Bemassung schon als Kreis umgesetzt wurde BemWrite = True ' Lesen wir also mal die DXF-Datei bis zu deren Ende ein Do While Not EOF(1) Line Input #1, CodeStr Code = Val(CodeStr) Line Input #1, Data ' Abfrage ob es sich um eine Bemassung handelt If Code = 0 And Data = "DIMENSION" Then BemAktiv = True ' Momentan wird eine Bemassung eingelesen If BemWrite = False Then ' wurde die letzte Bemassung schon als Kreis umgesetzt? KreiseZeichnen (BezPkt) ' wenn nicht, dann wird's Zeit, denn jetzt kommt End If ' eine neue Bemassung BemWrite = False ' Initialisierung für die aktuelle Bemassung For i = 0 To 3 ' Initialisierung des Bezugspunkt-Arrays BezPkt(i) = 0 Next i End If ' kommt ein anderes AutoCAD-Objekt??? If Code = 0 And Data <> "DIMENSION" Then BemAktiv = False If BemWrite = False Then ' Falls noch nicht gemacht, zeichen wir auch jetzt KreiseZeichnen (BezPkt) ' die Bezugskreise BemWrite = True ' Marker setzen, daß die Kreise schon erledigt sind End If End If If BemAktiv Then ' Jetzt werden die Bezugskoordinaten aus dem DXF gefieselt Select Case Code Case 13 ' Bezugspunkt 1 - Rechtswert BezPkt(0) = Val(Data) ' Ab in den Bezugspunktearray damit Case 23 ' Bezugspunkt 1 - Hochwert BezPkt(1) = Val(Data) Case 14 ' Bezugspunkt 2 - Rechtswert BezPkt(2) = Val(Data) Case 24 ' Bezugspunkt 2 - Hochwert BezPkt(3) = Val(Data) End Select End If Loop Close #1 End Sub Private Sub KreiseZeichnen(BezPkt) Dim MPkt(2) As Double Dim ActCircle As AcadCircle 'Radius für die Markierungen als Kreis Const Radius = 0.05 For j = 0 To 3 Step 2 ' wenn man weiß wohin, dann kann man 2 Kreise malen MPkt(0) = BezPkt(j) MPkt(1) = BezPkt(j + 1) MPkt(2) = 0 Set ActCircle = ThisDrawing.ModelSpace.AddCircle(MPkt, Radius) ActCircle.Layer = "BemMark" Next j End Sub Falls jemand noch was Eleganteres findet, dann möge er es doch bitte posten Gruß vom Hübi ------------------ Wissen ist Macht - nix wissen macht nix! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| TGA-Fachplaner (m/w/d) für den Bereich Elektrotechnik | Wir dürfen seit über 40 Jahren mit unseren rund 70 Mitarbeitern das gesamte Leistungsspektrum für die Technische Gebäudeausrüstung projektieren. Nun suchen wir Sie für unseren Standort in Kleve zum nächstmöglichen Zeitpunkt, als TGA-Fachplaner (m/w/d) für den Bereich Elektrotechnik
- zu Ihren Tätigkeiten gehören die ...
| Anzeige ansehen | Projektmanagement |
|
startrek Moderator Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 18. Jan. 2005 18:34 <-- editieren / zitieren --> Unities abgeben: Nur für Huebi
Abend Hübi, last but not least, ist zwar nicht die 'Bringer'-Antwort: Via '_points' setzt du Dir der Reihe nach die Punkte, die in der Maßkette enthalten sein sollen. Dann '_qdim' die Punkte auswählen, Maßkette platzieren und dann '_group' machste draus ne Gruppe? Das zu automatisieren, hab ich keine Ahnung, vorm Punkte erstellen A=Modelspace.Count, nach Ende _points E=Modelspace.Count, aus der Differenz die Schnellbemassung erstellen und C=Modelspace.Count und aus der Differenz C-A die Gruppe bilden? Aber das vbaisch ..., ka ;-)) Gruss Nancy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|