---

Wer kann helfen ?

Für die Ausgabe von Vermessungsplänen soll im Layout ein
pviewport gemäß Blattgröße angelegt werden (Klappt).
Die Orientierung und der Maßstab soll im Modelbereich des
pViewports eingestellt werden. (Klappt mit der Umrechnung der
Papierbereichswerte des Viewports)
Die untere linke Ecke soll auf einen Wert eingestellt werden. (Klappt).
Jetzt soll im Papierbreich (Layout) eine Fahnenbeschriftung und
Gitterkreuze angebracht werden. Das klappt nur wenn man die Modellbereichskoordinaten (Min/Max) des Viewports hat.

Wie kann ich diese Koordinaten ermitteln ?????

Gruß
Stelli2

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

---

Hatte mal gleiches Problem und habe es folgendermassen
(wahrscheinlich nicht ganz sauber) gelöst.

ThisDrawing.MSpace = True
Set aFenster = ThisDrawing.ActivePViewport
Dim obenRechts, untenLinks, obenLinks(0 To 2) As Double, untenRechts
untenLinks = ThisDrawing.GetVariable("extmin")
obenRechts = ThisDrawing.GetVariable("extmax")

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

---

Erst mal Danke für die Antwort.

Hab's direkt probiert. Die Funktion liefert leider aber die Extremwerte für die Entities (wie zoom Grenzen) und nicht die im pviewport dargestellten Koordinaten.

Gruß
Stelli1

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

---

Nochmal Danke für die Anregung mit den Variablen.

Wenn der pviewport aktiv ist und mspace=true dann
steht die Zentrumskoordinate (als 3DKoordinate) in der Variablen
"VIEWCTR". (leider nur read-only)

beispiel:
..
Dim aFenster As AcadPViewport
Dim Zentrum As Variant
Dim Koord(0 To 2) As Double
Dim msg As String

ThisDrawing.MSpace = True
Set aFenster = ThisDrawing.ActivePViewport
aFenster.Display True
ThisDrawing.MSpace = True

Zentrum = ThisDrawing.GetVariable("VIEWCTR")
If VarType(Zentrum) <> vbEmpty Then
    Koord(0) = Zentrum(0)
    Koord(1) = Zentrum(1)
    Koord(2) = Zentrum(2)
    msg = "Zentrum liegt bei " & vbCrLf
    msg = msg & Format(Koord(0), "0.00") & "  /  " & Format(Koord(1), "0.00")
    MsgBox msg
End If
...

Vielleicht kannt du es ja brauchen

Stelli1

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

---

Hallo,

bin durch Zufall auf diesen Thread gestoßen. Auch wenn die Lösung wahrscheinlich für Stelli1 zu spät kommt, nützt es vielleicht nachfolgenden.

Die Abfrage der Eckpunkte eines Ansichtsfensters in Modellkoordinaten ist bei www.acadx.de beschrieben. Dort schauen unter Programme/sonstiges. Das Programmbeispiel heißt "pFenster_koord".

MfG
Marco Schreiter

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

---

Zitat:

---

Original erstellt von Stelli1:

Die Orientierung und der Maßstab soll im Modelbereich des
pViewports eingestellt werden. (Klappt mit der Umrechnung der
Papierbereichswerte des Viewports)
Die untere linke Ecke soll auf einen Wert eingestellt werden. (Klappt).
Stelli2

---

Ich muss diesen Beitrag aus der Versenkung holen.
Habe grad ähnliches in Arbeit siehe hier

Wie hast Du obigen Teile (im Quote) gelöst?

Grüsse
Andreas

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

---

Hallo Andreas,

ich kann mich kaum noch erinnern.
Die (Welt)Koordinate des Ansichtsfensters, dass war doch das was du brauchst, ist in der Eigenschaft "Center" gespeichert.

Ich hab mal einen Codeausschnitt eingefügt. Vielleicht hilft er dir weiter.

Code:

---

Sub Werte_Aktualisieren()

   Dim Zentrum As Variant
     
   If Me.com_Layout.ListIndex = -1 Then
      MsgBox "Es ist kein Layout angegeben !" & vbCrLf & vbCrLf _
             & "Die Funktion kann nur im Layout ausgeführt werden!", vbCritical
      Exit Sub
   End If
  
   FrmFortschritt.Show
   FrmFortschritt.ProgressBar1.value = 0
   FrmFortschritt.ProgressBar1.Max = 1
  
   FrmFortschritt.Caption = "Layout setzen ..."
   obj_ACAD_app.ActiveDocument.ActiveSpace = acPaperSpace
   obj_ACAD_app.ActiveDocument.ActiveLayout = obj_ACAD_app.ActiveDocument.Layouts(Me.com_Layout.Text)
     
   If VarType(aFenster) = vbEmpty Then
      Exit Sub
   End If
  
   FrmFortschritt.Caption = "Fensterkoordinaten lesen ..."
  
   Zentrum = aFenster.Center
   PapierYZentrum = Zentrum(0)
   PapierXZentrum = Zentrum(1)
   ModelScale = aFenster.CustomScale
   PapierBreite = aFenster.width
   Papierhöhe = aFenster.Height
  
   FrmFortschritt.Caption = "Modelbereichskoordinaten lesen ..."
  
   obj_ACAD_app.ActiveDocument.MSpace = True
   aFenster.Display True
   Zentrum = obj_ACAD_app.ActiveDocument.GetVariable("VIEWCTR")
   If VarType(Zentrum) <> vbEmpty Then
          ModelYZentrum = Zentrum(0)
          ModelXZentrum = Zentrum(1)
   End If
   DrehungRad = aFenster.TwistAngle
   Drehung = Rad2Gon(aFenster.TwistAngle)
   Drehung = W400(Drehung)
   ' Drehrichtung ändern
   Drehung = ChangeRichtung(Drehung)
   '
  
   FrmFortschritt.Caption = "Alten Modelspace einschalten ..."

   obj_ACAD_app.ActiveDocument.MSpace = MspaceAktiv
  
   com_Massstab.Text = Format(1000# / ModelScale, "0")
   txt_ModelRechts.Text = Format(ModelYZentrum, "0.000")
   txt_ModelHoch.Text = Format(ModelXZentrum, "0.000")
  
   FrmFortschritt.Caption = "Eckkoordinaten rechnen ..."
 
'   ModelYuntenLinks = ModelYZentrum - ((PapierBreite / 2) / ModelScale) ' ??? * Sin(Gon2Rad(Drehung))
'   ModelXuntenLinks = ModelXZentrum - ((Papierhöhe / 2) / ModelScale) ' ???* Cos(Gon2Rad(Drehung))
   ' IO
   ModelYuntenLinks = ModelYZentrum - (((PapierBreite / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   ModelYuntenLinks = ModelYuntenLinks + (((Papierhöhe / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXuntenLinks = ModelXZentrum - (((PapierBreite / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXuntenLinks = ModelXuntenLinks - (((Papierhöhe / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   'IO
   ModelYuntenRechts = ModelYZentrum + (((PapierBreite / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   ModelYuntenRechts = ModelYuntenRechts + (((Papierhöhe / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXuntenRechts = ModelXZentrum + (((PapierBreite / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXuntenRechts = ModelXuntenRechts - (((Papierhöhe / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   'IO
   ModelYobenLinks = ModelYZentrum - (((PapierBreite / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   ModelYobenLinks = ModelYobenLinks - (((Papierhöhe / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXobenLinks = ModelXZentrum - (((PapierBreite / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXobenLinks = ModelXobenLinks + (((Papierhöhe / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   'IO
   ModelYobenRechts = ModelYZentrum + (((PapierBreite / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
   ModelYobenRechts = ModelYobenRechts - (((Papierhöhe / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXobenRechts = ModelXZentrum + (((PapierBreite / 2) / ModelScale) * Sin(Gon2Rad(Drehung)))
   ModelXobenRechts = ModelXobenRechts + (((Papierhöhe / 2) / ModelScale) * Cos(Gon2Rad(Drehung)))
  
   ModelBreite = PapierBreite / ModelScale
   Modelhöhe = Papierhöhe / ModelScale
   Me.txt_Breite = Format(ModelBreite, "0.000")
   Me.txt_Höhe = Format(Modelhöhe, "0.000")
   Me.txt_Drehung = Format(Drehung, "0.000")
  
   FrmFortschritt.Caption = "Maske aktualisieren..."
  
   If Me.op_BezugUntenLinks.value = True Then
        txt_ModelRechts.Text = Format(ModelYuntenLinks, "0.000")
        txt_ModelHoch.Text = Format(ModelXuntenLinks, "0.000")
   Else
        txt_ModelRechts.Text = Format(ModelYZentrum, "0.000")
        txt_ModelHoch.Text = Format(ModelXZentrum, "0.000")
   End If
   FrmFortschritt.Caption = "Fertig..."
  
   Unload FrmFortschritt
  
End Sub

---

Zu deinem Problem aus dem anderen Thread:
Ich würde einen tmpBlock nach den Blattgrößen erzeugen. Diesen kannst du per Sendcommand einfügen. Dann hast du den Block am Fadenkreuz. Über die Auswertung der AutoCAD events kannst du nach Befehlsende feststellen ob die Anzahl der Entitys um 1 erhöht ist. Wenn das so ist, ist der Block auch wirklich eingefügt worden, sonst hat der Benutzer abgebrochen. Auf das Letzte Elemnt kannst du ja mit Hilfe der Count EIgenschaft zugreifen.
Du liest die EInfügekoordinaten des Blockes und löschst ihn wieder. Dann überträgst du die Koordinaten als Zentrumskoordinaten in ein Ansichtsfenster, was du vorher entsprechend deiner Papiergröße eingerichtet hast.    

Viel Erfolg
Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht. 
www.ib-stelberg.de

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

---

Hallo Andreas,

hab noch was gefunden.

Code:

---

Private Sub BT_Bezugspunkt_Click()
    Dim varPunkt As Variant
    Dim dblPunkt(0 To 2) As Double
    Dim Angabe As Boolean
    Dim Massstab As Double
   
    If obj_ACAD_app.ActiveDocument.ActiveSpace = acModelSpace Then
        MsgBox "Im Modellbereich gibt es keine gültigen Ansichtsfenster!" _
              & vbCrLf & vbCrLf _
              & "Wählen sie ein Layout aus und versuchen es noch einmal.", vbCritical
        Exit Sub
    End If
   
   
    If Not aFenster Is Nothing Then
      obj_ACAD_app.ActiveDocument.MSpace = True
      aFenster.Display True
      Debug.Print PapierBreite
      Massstab = aFenster.CustomScale
      Angabe = ac_getPoint(dblPunkt(0), dblPunkt(1), dblPunkt(2), Me)
      If Angabe = True Then
          If Me.op_BezugUntenLinks.value = True Then
            dblPunkt(0) = dblPunkt(0) + ModelBreite / 2
            dblPunkt(1) = dblPunkt(1) + Modelhöhe / 2
          End If
          obj_ACAD_app.ZoomCenter dblPunkt, Papierhöhe / Massstab
          'aFenster.CustomScale = Massstab
          Werte_Aktualisieren
      End If
     
    End If
End Sub

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Wilfried,

vilen Dank für die Hilfe.
Das hilft mir schon sehr viel weiter.

Punkt in Modellbereich auswählen und dann im Ansfen auf ZoomCenter einfügen hatte ich jetzt schon.
(gab nur noch ein Problem mit Magnify)

Deine Codeschnippsel helfen mir aber sehr viel weiter und die Idee mit dem temp. Block ist genau das was ich gesucht habe.

Danke
Andreas

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

---

Hallo,

nachdem mein passendes Problem zu diesem Beitrag gelöst ist,
BITTE in diesem Beitrag bei einer Lösung weiterhelfen

Danke
Andreas

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