---

Hallo!
Ich habe hier eine Lisp Funktion die ich in .NET realisieren will.
Kann mir jemand sagen ob das möglich ist?
Kurze Beschreibungen sind dabei.
Die Funktion holt rahmen, sk vom Modell ins Layout.

ssobjs = In anderer Funktion über Selectionset geholt (Rahmen und SK)
NullP = einfügepunkt des rahmens
ScaleFaktor = Skalierungsfaktor

Problem: Über dass skalieren der Objekte merkt er sich die Positionen des Schriftkopfes relativ zum rahmen.
Suche ich mir den Rahmen und SK (merke mir hier die Position) einzeln und füge sie über eine .NET insert Funktion ein, ist der Rahmen nicht mehr dort wo er im Modell war.
Oder kann man das in .NET auch machen, dass objekte in einem Selectionset auch skaliert werden und dann gebündelt eingefügt?

defun RaSK2Lay(ssObjs NullP ScaleFk / LU RO)

;Zomm alles sehen
(command "_zoom" "_e")
;Skalieren der objekte ssobjs (in einer anderen funktion über selectionset geholt) vom nullpunkt des rahmens mit faktor
(command "_scale" ssObjs "" NullP (/ 1 ScaleFk))
;Elemente kopieren vom nullpunkt aus
(command "_copyBase" NullP ssObjs "")
;Auf papier schalten
(setvar "tilemode" 0)
;einfügen auf 0,0,0
(command "_pasteclip" '(0 0 0))
;Linksunten rechtsoben zuweisen
(setq LU (getvar "EXTMIN"))
(setq RO (getvar "EXTMAX"))

;leeren viewport erstellen
(command "_vports" "")
;wieder löschen
(entdel (entlast))
;wieder erzeugen mit links unten  rechts oben
(command "_vports" "_restore" "" LU RO)
;auf layer am_VIEWS legen
(command "_change" "_last" "" "_prop" "_layer" "AM_VIEWS" "")
;Mspace (auf modell durchschauen)
(command "_MSPACE")
;zoom 1/ scalefaktor von der übergabe
(command "_ZOOM" (strcat (rtos (/ 1 ScaleFk) 2 2) "xp"))
;auf papierbereich
(command "_PSPACE")
;sperren
(command "_-vports" "_lock" "_on" (entlast) "")
;layer einschalten plot ausschalten
(command "_layer" "_on" "AM_VIEWS" "_plot" "_no" "AM_VIEWS" "")
;Modellbereich
(setvar "tilemode" 1)
;SK RA löschen
(command "_erase" ssObjs "")
;Papierbereich
(setvar "tilemode" 0)
;zoom
(command "_zoom" "_e")
)

mfg

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

---

Hi,

kannst bitte Zeichnung beiliegen mit

a) Ursprungszustand
b) Zielzustand

...also mal händisch das ganze durchmachen, das steigert mein Vorstellungsvermögen (z.B. hast Du in Deinem Lisp nirgends angegeben, aus welches Layout er schalten soll, ... wird dann vielleicht klarer)

Ein ganzes SelectionSet skalieren geht nicht, aber Du kannst Dir eine Skalierungs-Matrix anlegen und dann alle Elemente des SelectionSets mit dieser Matrix 'behandeln'.

- alfred -

------------------
www.hollaus.at

---

K122064_A-6.dwg

hallo!
Anbei die 2 Zeichnungen.

Also in der Form war es so, wenn Rahmen und SK im Layout waren, wurde davon ausgegangen, dass alle Layouts leer sind.
Dann wurde einfach auf das erste Layout mittels tilemode umgeschaltet und die Objekte rüberkopiert.

ich möchte es aber so intelligent machen, dass es auf das erste leere Layout kommt.

mfg

EDIT:
Irgend etwas funktioniert da beim Upload nicht, die datei Ist ungültig wenn man sie downloadet...

Kurz nochmal eine Erklärung
A:
Zeichnung + Rahmen + SK im Modell

B
Zeichnung im Modell
Rahmen + SK im Layout
Ansichtsfenster wird im Layout erstellt.
Dann Zoom eingestellt dass Zeichnung im Ansichtsfenster sichtbar wird.

hoffe es hilft weiter und du kannst es dir vorstellen
[Diese Nachricht wurde von veydan am 10. Jun. 2009 editiert.]

[Diese Nachricht wurde von veydan am 10. Jun. 2009 editiert.]

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

---

Hi,

... und Rahmen und Schriftkopf liegen waagrecht im Modellbereich?
... und woher nimmt das Layout seine Seiteneinrichtung?

- alfred -

------------------
www.hollaus.at

---

ja liegen waagrecht im modell.

die werden später von mir eingestellt funktion existiert bereits.

Habe die Dateien bei einem Filehoster raufgeladen:

vorher.dwg http://www.fileuploadx.de/957086

nachher.dwg http://www.fileuploadx.de/695151

mfg

[Diese Nachricht wurde von veydan am 10. Jun. 2009 editiert.]

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

---

Hi,

ausser Ansichtsfenster mal (aber ohne Seiteneinrichtung macht das wohl auch wenig Sinn), lass mich mal wissen,wie's Dir damit geht:

Code:

---

   Public Shared Sub CADde_ModSP_to_Layout()
      Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
      Dim tDocLock As ApplicationServices.DocumentLock = Nothing
      Dim tTrAct As DatabaseServices.Transaction = Nothing
      Try
         Dim tAcadDocDB As DatabaseServices.Database = tAcadDoc.Database
         Dim tAcadDocED As EditorInput.Editor = tAcadDoc.Editor

         tDocLock = tAcadDoc.LockDocument
         tTrAct = tAcadDoc.TransactionManager.StartTransaction

         'zuerst mal ModelSpace zum Schreiben holen
         Dim tBlTab As DatabaseServices.BlockTable = CType(tTrAct.GetObject(tAcadDoc.Database.BlockTableId, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTable)
         Dim tModSp As DatabaseServices.BlockTableRecord = CType(tTrAct.GetObject(tBlTab(DatabaseServices.BlockTableRecord.ModelSpace), DatabaseServices.OpenMode.ForWrite, True, True), DatabaseServices.BlockTableRecord)

         'zuerst Elemente auswählen lassen, die auf das erste Layout kopiert werden sollen
         Dim tPrompt As EditorInput.PromptSelectionOptions = New EditorInput.PromptSelectionOptions()
         tPrompt.MessageForAdding = "zu kopierende Elemente wählen: "
         Dim tSelSetRes As EditorInput.PromptSelectionResult = tAcadDocED.GetSelection(tPrompt)
         If tSelSetRes.Status = EditorInput.PromptStatus.OK Then
            'Selection wurde zumindest mit OK bestaetigt
            If (tSelSetRes.Value IsNot Nothing) AndAlso (tSelSetRes.Value.Count > 0) Then
               'ok, es sind auch Elemente vorhanden
               Dim tLayoutBlDef As DatabaseServices.BlockTableRecord = getEmptyLayout(tTrAct, tBlTab)
               If tLayoutBlDef IsNot Nothing Then
                  'ok, leeres Layout gefunden

                  'wir oeffnen die Layout-Blockdefinition es mal zum schreiben
                  tLayoutBlDef = CType(tTrAct.GetObject(tLayoutBlDef.ObjectId, DatabaseServices.OpenMode.ForWrite, False, False), DatabaseServices.BlockTableRecord)

                  'und jetzt kopieren wir die Elemente hinein (und sammeln gleichzeitig die kopierten Elemente + Extents derer)
                  Dim tCopyColl As DatabaseServices.DBObjectCollection = New DatabaseServices.DBObjectCollection
                  Dim tCopyExtents As DatabaseServices.Extents3d
                  For Each tObjID As DatabaseServices.ObjectId In tSelSetRes.Value.GetObjectIds
                     'erstmal Element kopieren
                     Dim tDBObj As DatabaseServices.Entity = TryCast(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.Entity)
                     If tDBObj IsNot Nothing Then
                        'dann einfuegen in die Blockdefinition des Layouts
                        Dim tDBObjClone As DatabaseServices.Entity = CType(tDBObj.Clone, DatabaseServices.Entity)
                        tLayoutBlDef.AppendEntity(tDBObjClone)
                        tTrAct.AddNewlyCreatedDBObject(tDBObjClone, True)
                        tCopyColl.Add(tDBObjClone)
                        'und die Extents sammeln wir auch gleich
                        'vorsicht, die Extents können bei Texten oder Attriuten Fehler liefern
                        If tCopyColl.Count = 1 Then
                           tCopyExtents = tDBObjClone.GeometricExtents
                        Else
                           tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MinPoint)
                           tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MaxPoint)
                        End If
                     End If
                  Next

                  'und wenn Elemente jetzt kopiert wurden, dann schieben zu Layout-0,0
                  'und weil ich nicht weiss, wie zu Skalieren ist, ist da mal nix damit
                  Dim tMoveMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(New Geometry.Vector3d(-tCopyExtents.MinPoint.X, -tCopyExtents.MinPoint.Y, -tCopyExtents.MinPoint.Z))
                  For Each tDBObj As DatabaseServices.Entity In tCopyColl
                     tDBObj.TransformBy(tMoveMat)
                  Next

                  'und das sollte es gewesen sein, jetzt würde noch ansichtsfenster zu erstellen sein, aber das wird ja wohl gehen, oder?

                  tTrAct.Commit()

               Else
                  Call MsgBox("Kein leeres Layout gefunden")
               End If
            Else
               Call MsgBox("Keine Elemente gewählt")
            End If
         End If

      Catch ex As Exception
         Debug.Print(ex.Message.ToString)
      Finally
         If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
         If tDocLock IsNot Nothing Then tDocLock.Dispose() : tDocLock = Nothing
      End Try
   End Sub
   Private Shared Function getEmptyLayout(ByRef TrAct As DatabaseServices.Transaction, ByRef BlTab As DatabaseServices.BlockTable) As DatabaseServices.BlockTableRecord
      'sucht leeres layout und retourniert die blockdefinition davon, wenn eines gefunden wurde
      Dim tRetVal As DatabaseServices.BlockTableRecord = Nothing

      'wir suchen die blockdefinitionen durch und daraus mal alles, was layouts sind
      For Each tBlDefID As DatabaseServices.ObjectId In BlTab
         If (tBlDefID.IsValid) AndAlso (Not tBlDefID.IsErased) Then
            Dim tBlDef As DatabaseServices.BlockTableRecord = CType(TrAct.GetObject(tBlDefID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTableRecord)
            If tBlDef.IsLayout Then
               'hier haben wir mal ein layout, jetzt sehen wir nach, ob es leer ist
               Dim tEntCount As Integer = 0
               For Each tObjID As DatabaseServices.ObjectId In tBlDef
                  If (tObjID.IsValid) AndAlso (Not tObjID.IsErased) Then
                     'es koennte sein, dass es dummy-elemente drin gibt, die aber keine zeichnungselemente sind
                     'das muss hier noch geprueft werden, ob der zaehler wirklich hochgezaehlt wird
                     'dann muss statt folgendem 'TRUE' das kriterium gesetzt werden
                     If True Then tEntCount += 1
                     'eigentlich koennen wir (nach obiger pruefung) schon aussteigen
                     If tEntCount > 0 Then Exit For
                  End If
               Next
               If tEntCount = 0 Then
                  'ok, es scheint leer zu sein, also koennen wir dieses retournieren
                  tRetVal = tBlDef
                  Exit For
               End If
               Debug.Print(tBlDefID.ObjectClass.DxfName)
            End If
         End If

      Next

      Return tRetVal
   End Function

---

- alfred -

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 10. Jun. 2009 editiert.]

---

die funktion ist super, hab sie zwar noch umgebaut auf einen SelectionFilter, aber damit gehts auch perfekt!

Bei manchen Layouts sagt er, obwohl ich alle Objekte gelöscht habe, dass es keine leeren Layouts gibt.
Nur wenn ich eines neu erzeuge funktioniert es gleich. Wenn ich Strg + a + delete mache und nochmal probiere gehts nicht mehr, da es anscheinend nicht leer ist.

Was meinst du mit dummy-elementen? kann es solche nach meinem löschen noch geben?

mfg

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

---

HI, 

Zitat:

---

Was meinst du mit dummy-elementen? kann es solche nach meinem löschen noch geben?

---

...das sind Elemente, die in der Datenbank vorhanden sind, aber nicht angezeigt werden, z.B. setzt Civil3D immer solche Elemente in ein Layout (dahinter in XRecords), um sich Projekteinstellungen zu halten, aber da gibt's tausend Gründe.

Setz Dir mal an die Stelle (...If True Then tEntCount += 1...) einen BreakPoint, hol Dir aus der ObjectID das Element und schau nach, welcher Elementtyp das ist (nach Deinem Löschen der Layoutinhalte).

- alfred -

------------------
www.hollaus.at

---

es ist noch eine Blockreference und ein Viewport da.

finde ich etwas komisch.

edit: ansichtsfenster habe ich aber noch keines erstellt.

[Diese Nachricht wurde von veydan am 10. Jun. 2009 editiert.]

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

---

Hi,

Viewport kann ich verstehen, wenn das Layout schon mal aktiv war, denn der Papierbereich des Layouts wird ähnlich wie ein Viewport behandelt.

BlockReference kann ich nicht verstehen, das solltest Du mal den Blocknamen herausholen bzw. Dir ansehen, woraus diese BlockReference besteht, möglicherweise sind da keine Elemente drin, daher auch mit <Strg>-A nicht wählbar.

Du hast aber in der Schleife die Möglichkeit, selbst Bedingungen zu setzten, was in einem 'leeren Layout' vorhanden sein darf und was nicht.

- alfred -

------------------
www.hollaus.at

---

der blocktablerecord kommt vom Modell.

bzgl dem ansichtsfenster
Welches Objekt ist dass?
Databaseservices.Viewport
Databaseservices.ViewportTable
Databaseservices.ViewportTableRecord
Databaseservices.ViewTable
Databaseservices.ViewTableRecord

gibts da wo eine Referenz für die ganzen Einstellungen (größe, position,etc..)

mfg
mfg

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

---

Hi,

ich bin überfordert 

der blocktablerecord kommt vom Modell ==> sorry, aber Modellbereich ist ein BlockTableRecord, was meinst Du mit 'kommt von Modell'?

Die restliche Auflistung zeigt was? Wo kommt die Liste her? Zeig mir das Codeschnippsel, das diese Liste erzeugt.

- alfred -

------------------
www.hollaus.at

---

Ja er gibt eben das Modell als blocktablerecord zurück.
Ich habe nur ne Msgbox mit Objekt.tostring ausgegeben um zu überprüfen was da noch da ist, weil es nicht leer ist.
Modell war BlocktableRecord und das Layout war der Viewport. Darum war es nie 0 und darum war kein Layout leer.
Nur eben die noch nie aktivierten die ich kurz davor erzeugt hatte, aber dass habe ich jetzt überprüft.
Egal, dass hat sich eh aufgeklärt.

das Codegeschnipsel ist die Frage, was davon ein Ansichtsfenster erzeugt/ist.
es ist nur eine Liste der View Objekte die ich unter DatabaseServices gefunden habe.

Ich habe zwar Codebeispiele, aber in keinem wird ein Ansichtsfenster erstellt/verwendet, darum die Frage ob es wo eine Referenz gibt wo sowas gemacht wird.

mfg

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

---

Hi

'Objekt.tostring' liefert Dir IRGENDWAS zurück, solange Du nicht weisst, welche Eigenschaft eines Objekts mit '.ToString' er ausgibt, hilft Dir das wenig. Die schnellste Überprüfung, wenn Dir nur die ObjectID zur Verfügung steht (und Du das Objekt nicht öffnen willst), wäre z.B.

Debug.Print(tObjID.ObjectClass.DxfName)

Auf die schnelle habe ich auch kein Beispiel für Ansichtsfenster erstellen bei der Hand (zuerst fehlt Dir aber auch noch die Seiteneinrichtung!), aber geh mal den umgekehrten Weg: erstelle händisch ein Layout mit Ansichtsfenster und schau Dir dann den Inhalt der Blockdefinition des Layouts an, einfach durchscannen, bis Du beim Ansichtsfenster bist und dann die Eigenschaften im Bebug ansehen.

- alfred -

------------------
www.hollaus.at

---

Ist ObjectClass durch etws zu ersetzen, oder Fehlt mir ein Verweis auf eine .dll?

unter tBlDefID gibt es bei mir keine ObjectClass

mfg

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

---

AutoCAD-Version? (bitte mal die Systeminfo ausfüllen!)

- alfred -

------------------
www.hollaus.at

---

Mechanical 2009

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

---

Hi,

dann sollte es eigentlich auch bei Dir möglich sein, im Objectbrowser sehe ich folgende signature:

Public ReadOnly Property ObjectClass() As Autodesk.AutoCAD.Runtime.RXClass
    Member von Autodesk.AutoCAD.DatabaseServices.ObjectId

und ist Bestandteil von acdbmgd.dll

- alfred -

------------------
www.hollaus.at

---

Nein, bei mir ist das nicht sichtbar.
Ich habe die acdbmgd.dll vom ObjectARX 2009 (das ich von der Autodeskseite runtergeladen habe) eingebunden.
Version ist 17.1.0.0

Wenn ich die dll vom ObjectARX 2010 einbinde, dann ist ObjectClass sichtbar.
Version der dll 18.0.0.0

Gibt es vl noch eine 17.2.0.0 wo die ObjectClass enthalten ist?
Könntest du deine dll mal hier hochladen?

mfg

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

---

Hi, 

Zitat:

---

Ich habe die acdbmgd.dll vom ObjectARX 2009

---

Fehler!! Nimm immer das vom AutoCAD-Installationsverzeichnis.

17.1 ist 2008
17.2 ist 2009

- alfred -

------------------
www.hollaus.at

---

so, jetzt muss ich den Thread nochmal ausgraben.

in vba wird das Ansichtsfenster ja so erstellt

Set Vport = ThisDrawing.PaperSpace.AddPViewport(center, L, H)

hier ist mein aktueller .net Code:
x,y werden übergeben sind Geometry.Point3d mit z wert 0

Code:

---

Dim ansichtsfenster As New Viewport
ansichtsfenster.GeometricExtents.Set(x, y)

Dim objid As DatabaseServices.ObjectId
Dim pt1 As New Geometry.Point3d(100, 100, 0)
ansichtsfenster.CenterPoint = pt1
objid = layrec.AppendEntity(ansichtsfenster)

---

eine objid kommt zurück, aber ich kann nix sehen im layout.

mfg

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

---

Hi,

>> objid = layrec.AppendEntity(ansichtsfenster)

Was ist 'layrec' für ein Objekttyp? Doch nicht ein LayerTableRecord?

Ich glaube auch, dass die Erstellung eines Ansichtsfensters in Layout als Beispiel im ArxDoc enthalten ist oder in den Samples vom ObjectARX-Kit enthalten ist.

- alfred -

------------------
www.hollaus.at

---

nein layrec ist der BlocktableRecord vom Layout bei deinem BSP tLayoutBlDef.
Dann such ich mal in den samples danke

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

---

Ich brings einfach nicht hin, dass er irgend ein Ansichtsfenster ins Layout zeichnet...

hier nochmal die ganze funktion von dir, mit dem Ansichtsfenster Code:

Code:

---

Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim tDocLock As ApplicationServices.DocumentLock = Nothing
        Dim tTrAct As DatabaseServices.Transaction = Nothing
        Dim Filter(2) As DatabaseServices.TypedValue
        Dim tLayoutBlDef As DatabaseServices.BlockTableRecord
        Try
            Dim tAcadDocDB As DatabaseServices.Database = tAcadDoc.Database
            Dim tAcadDocED As EditorInput.Editor = tAcadDoc.Editor

            tDocLock = tAcadDoc.LockDocument
            tTrAct = tAcadDoc.TransactionManager.StartTransaction

            Filter(0) = New DatabaseServices.TypedValue( _
            DatabaseServices.DxfCode.Start, "INSERT")
            Filter(1) = New DatabaseServices.TypedValue( _
          DatabaseServices.DxfCode.BlockName, "TITLE_*,RA0,RA0x1_5,RA0x2,RA1,RA1x1_5,RA1x2,RA2,RA3,RA4")
            Filter(2) = New DatabaseServices.TypedValue( _
              DatabaseServices.DxfCode.LayoutName, "Model*")
            Dim tAcadSelectFilter As New EditorInput.SelectionFilter(Filter)

            'zuerst mal ModelSpace zum Schreiben holen
            Dim tBlTab As DatabaseServices.BlockTable = CType(tTrAct.GetObject(tAcadDoc.Database.BlockTableId, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTable)
            Dim tModSp As DatabaseServices.BlockTableRecord = CType(tTrAct.GetObject(tBlTab(DatabaseServices.BlockTableRecord.ModelSpace), DatabaseServices.OpenMode.ForWrite, True, True), DatabaseServices.BlockTableRecord)

            'Dim objs As DBObjectCollection = New DBObjectCollection
            'Dim cir As Circle = New Circle(New Geometry.Point3d(3.4, 1.9, 0), Geometry.Vector3d.ZAxis, 0.9)
            'objs.Add(cir)

            'zuerst Elemente auswählen lassen, die auf das erste Layout kopiert werden sollen
            'Dim tPrompt As EditorInput.PromptSelectionOptions = New EditorInput.PromptSelectionOptions()
            'tPrompt.MessageForAdding = "zu kopierende Elemente wählen: "
            Dim tSelSetRes As EditorInput.PromptSelectionResult = tAcadDocED.SelectAll(tAcadSelectFilter) 'tAcadDocED.GetSelection(tPrompt)
            'If tSelSetRes.Status = EditorInput.PromptStatus.OK Then
            'Selection wurde zumindest mit OK bestaetigt
            If (tSelSetRes.Value IsNot Nothing) AndAlso (tSelSetRes.Value.Count > 0) Then
                'ok, es sind auch Elemente vorhanden
                tLayoutBlDef = getEmptyLayout(tTrAct, tBlTab)

                If tLayoutBlDef IsNot Nothing Then
                    'ok, leeres Layout gefunden

                    'wir oeffnen die Layout-Blockdefinition es mal zum schreiben
                    tLayoutBlDef = CType(tTrAct.GetObject(tLayoutBlDef.ObjectId, DatabaseServices.OpenMode.ForWrite, False, False), DatabaseServices.BlockTableRecord)

                    'und jetzt kopieren wir die Elemente hinein (und sammeln gleichzeitig die kopierten Elemente + Extents derer)
                    Dim tCopyColl As DatabaseServices.DBObjectCollection = New DatabaseServices.DBObjectCollection
                    Dim tCopyExtents As DatabaseServices.Extents3d
                    For Each tObjID As DatabaseServices.ObjectId In tSelSetRes.Value.GetObjectIds
                        'erstmal Element kopieren
                        Dim tDBObj As DatabaseServices.Entity = TryCast(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.Entity)
                        If tDBObj IsNot Nothing Then
                            'dann einfuegen in die Blockdefinition des Layouts
                            Dim tDBObjClone As DatabaseServices.Entity = CType(tDBObj.Clone, DatabaseServices.Entity)

                            tLayoutBlDef.AppendEntity(tDBObjClone)
                            tTrAct.AddNewlyCreatedDBObject(tDBObjClone, True)
                            tCopyColl.Add(tDBObjClone)
                            'und die Extents sammeln wir auch gleich
                            'vorsicht, die Extents können bei Texten oder Attriuten Fehler liefern

                            If tCopyColl.Count = 1 Then
                                tCopyExtents = tDBObjClone.GeometricExtents
                            Else
                                tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MinPoint)
                                tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MaxPoint)
                            End If
                        End If
                    Next

                    'und wenn Elemente jetzt kopiert wurden, dann schieben zu Layout-0,0
                    'und weil ich nicht weiss, wie zu Skalieren ist, passen wir die Elemente auch an die Größe des Layouts an
                    Dim tMoveMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(New Geometry.Vector3d(-tCopyExtents.MinPoint.X, -tCopyExtents.MinPoint.Y, -tCopyExtents.MinPoint.Z))
                    For Each tDBObj As DatabaseServices.Entity In tCopyColl
                        tDBObj.TransformBy(tMoveMat)
                    Next

                    'und das sollte es gewesen sein, jetzt würde noch ansichtsfenster zu erstellen sein, aber das wird ja wohl gehen, oder?
                   
                 
                    Dim vp As Viewport = New Viewport
                    tLayoutBlDef.AppendEntity(vp)
                    tTrAct.AddNewlyCreatedDBObject(vp, True)

                    'Ein paar andere Versuche... vp.ViewHeight = 300
                    '  vp.NonRectClipOn = False
                    'vp.On = True

                  'Dim vp As Viewport = New Viewport
                    'tLayoutBlDef.AppendEntity(vp)
                    'tTrAct.AddNewlyCreatedDBObject(vp, True)
                    'vp.NonRectClipEntityId = id
                    'vp.NonRectClipOn = False
                    'vp.On = True

                    tTrAct.Commit()

                Else
                    MsgBox("Kein leeres Layout gefunden")
                End If
            Else
                MsgBox("Keine Elemente gefunden")
            End If
            'End If
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        Finally
            If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
            If tDocLock IsNot Nothing Then tDocLock.Dispose() : tDocLock = Nothing
        End Try

---

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

---

Hi,

lass mal wissen, ob dieses bei Dir funktioniert. Vorsicht, die Funktion getEmptyLayout hab ich modifiziert.

Code:

---

  Public Shared Sub CADde_CreateLayoutView()
      Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
      Dim tDocLock As ApplicationServices.DocumentLock = Nothing
      Dim tTrAct As DatabaseServices.Transaction = Nothing
      Dim tLayoutBlDef As DatabaseServices.BlockTableRecord
      Try
        Dim tAcadDocDB As DatabaseServices.Database = tAcadDoc.Database
        Dim tAcadDocED As EditorInput.Editor = tAcadDoc.Editor

        tDocLock = tAcadDoc.LockDocument
        tTrAct = tAcadDoc.TransactionManager.StartTransaction

        'BlockTable oeffnen
        Dim tBlTab As DatabaseServices.BlockTable = CType(tTrAct.GetObject(tAcadDoc.Database.BlockTableId, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTable)

        'ok, in der BlockTable nach Layouts suchen, die leer sind
        tLayoutBlDef = getEmptyLayout(tTrAct, tBlTab)

        If tLayoutBlDef IsNot Nothing Then
            'ok, leeres Layout gefunden

            'wir oeffnen die Layout-Blockdefinition es mal zum schreiben
            tLayoutBlDef = CType(tTrAct.GetObject(tLayoutBlDef.ObjectId, DatabaseServices.OpenMode.ForWrite, False, False), DatabaseServices.BlockTableRecord)

            Dim vp As Viewport = New Viewport
            vp.Height = 100
            vp.Width = 100
            vp.CenterPoint = New Geometry.Point3d(50, 50, 0)
            tLayoutBlDef.AppendEntity(vp)
            tTrAct.AddNewlyCreatedDBObject(vp, True)

            'vp.On = True    'funktioniert nur, wenn das Layout aktiv ist

            tTrAct.Commit()

        Else
            MsgBox("Kein leeres Layout gefunden")
        End If
      Catch ex As Exception
        MsgBox(ex.Message.ToString)
      Finally
        If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
        If tDocLock IsNot Nothing Then tDocLock.Dispose() : tDocLock = Nothing
      End Try
  End Sub

---

Code:

---

  Private Shared Function getEmptyLayout(ByRef TrAct As DatabaseServices.Transaction, ByRef BlTab As DatabaseServices.BlockTable) As DatabaseServices.BlockTableRecord
      'sucht leeres layout und retourniert die blockdefinition davon, wenn eines gefunden wurde
      Dim tRetVal As DatabaseServices.BlockTableRecord = Nothing

      'wir suchen die blockdefinitionen durch und daraus mal alles, was layouts sind
      For Each tBlDefID As DatabaseServices.ObjectId In BlTab
        If (tBlDefID.IsValid) AndAlso (Not tBlDefID.IsErased) Then
            Dim tBlDef As DatabaseServices.BlockTableRecord = CType(TrAct.GetObject(tBlDefID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTableRecord)
            If tBlDef.IsLayout Then
              'hier haben wir mal ein layout, jetzt sehen wir nach, ob es leer ist
              Dim tEntCount As Integer = 0
              For Each tObjID As DatabaseServices.ObjectId In tBlDef
                  If (tObjID.IsValid) AndAlso (Not tObjID.IsErased) Then
                    'es koennte sein, dass es dummy-elemente drin gibt, die aber keine zeichnungselemente sind
                    'das muss hier noch geprueft werden, ob der zaehler wirklich hochgezaehlt wird
                    'dann muss statt folgendem 'TRUE' das kriterium gesetzt werden
                    Debug.Print(tObjID.ObjectClass.DxfName)
                    If (tObjID.ObjectClass.DxfName <> "VIEWPORT") Then 'ein Ansichtsfenster, das als Ersatz fuer die Papierbereichsansicht steht, darf sein
                        tEntCount += 1
                    End If
                    'eigentlich koennen wir (nach obiger pruefung) schon aussteigen
                    If tEntCount > 0 Then Exit For
                  End If
              Next
              If tEntCount = 0 Then
                  'ok, es scheint leer zu sein, also koennen wir dieses retournieren
                  tRetVal = tBlDef
                  Exit For
              End If
              Debug.Print(tBlDefID.ObjectClass.DxfName)
            End If
        End If

      Next

      Return tRetVal
  End Function

---

- alfred -

------------------
www.hollaus.at

---

Hallo!
perfekt, dass Ansichtsfenster ist da!!DANKE!
Ich muss aber diese getEmptyLayout Funktion nehmen, bei der anderen findet er keins.(sind wie oben im Thread vermutlich schon kelinere sachen drinnen die man nicht sieht)

Viel Unterschied war nicht zu meiner Methode, aber das gewisse etwas fehlte...

Code:

---

Private Shared Function getEmptyLayout(ByRef TrAct As DatabaseServices.Transaction, ByRef BlTab As DatabaseServices.BlockTable) As DatabaseServices.BlockTableRecord
        'sucht leeres layout und retourniert die blockdefinition davon, wenn eines gefunden wurde
        Dim tRetVal As DatabaseServices.BlockTableRecord = Nothing

        'wir suchen die blockdefinitionen durch und daraus mal alles, was layouts sind
        For Each tBlDefID As DatabaseServices.ObjectId In BlTab
            If (tBlDefID.IsValid) AndAlso (Not tBlDefID.IsErased) Then
                Dim tBlDef As DatabaseServices.BlockTableRecord = CType(TrAct.GetObject(tBlDefID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.BlockTableRecord)
                If tBlDef.IsLayout And tBlDef.Name <> "*Model_Space" Then

                    'hier haben wir mal ein layout, jetzt sehen wir nach, ob es leer ist
                    Dim tEntCount As Integer = 0
                    For Each tObjID As DatabaseServices.ObjectId In tBlDef
                        If (tObjID.IsValid) AndAlso (Not tObjID.IsErased) Then
                            'es koennte sein, dass es dummy-elemente drin gibt, die aber keine zeichnungselemente sind
                            'das muss hier noch geprueft werden, ob der zaehler wirklich hochgezaehlt wird
                            'dann muss statt folgendem 'TRUE' das kriterium gesetzt werden
                            If True Then
                                Try
                                    'Dim tacadent1 As DatabaseServices.Entity = CType(TrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForWrite, True, True), DatabaseServices.Entity)
                                    If tObjID.ObjectClass.DxfName = "VIEWPORT" Then
                                        Dim tviewp As DatabaseServices.Viewport = CType(TrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForWrite, True, True), DatabaseServices.Viewport)
                                        ' MsgBox("Minpoint: X-" & tviewp.GeometricExtents.MinPoint.X & " Y-" & tviewp.GeometricExtents.MinPoint.Y & " Z-" & tviewp.GeometricExtents.MinPoint.Z & vbNewLine & _
                                        '"Maxpoint: X-" & tviewp.GeometricExtents.MaxPoint.X & " Y-" & tviewp.GeometricExtents.MaxPoint.Y & " Z-" & tviewp.GeometricExtents.MaxPoint.Z & _
                                        'vbNewLine)

                                    End If
                                Catch ex As Exception
                                    'MsgBox(ex.Message & ex.StackTrace)
                                    tEntCount += 1
                                End Try
                            End If
                        End If

                        If tEntCount > 0 Then Exit For
                    Next
                    If tEntCount = 0 Then
                        'ok, es scheint leer zu sein, also koennen wir dieses retournieren
                        tRetVal = tBlDef
                        Exit For
                    End If
                End If
                'eigentlich koennen wir (nach obiger pruefung) schon aussteigen
            End If
        Next

        'MsgBox(tBlDefID.ObjectClass.DxfName)
        Return tRetVal
    End Function

---

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

---

Hallo!
Ich habe noch ein Problem mit der richtigen Darstellung des Modellbereichs in der VIEW.

In welcher Eigenschaft ist gespeichert, welcher Bereich des Modellbereichs angezeigt wird?

mfg

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

---

Hi,

nicht nachgeforscht, aber es gibt so was wie .Center und dann noch .Width bzw. .Height (die Eigenschaften können klein wenig anders benannt sein, sollte damit aber auffindbar sein).

Das gilt natürlich nur, wenn Du 2D drauschaust, bei 3D gibt es dann ähnlich Eigenschaften wie die einer Kamera (bzw. View). Lass wissen, wenn Du das brauchst, dann geh ich suchen.

- alfred -

------------------
www.hollaus.at

---

Es gibt folgende Eigenschaften die naheliegen mit dem Problem etwas zu tun zu haben:
Habe die Properties mit einer Erklärung ergänzt so wie ich dass Verstanden habe

Viewport.Height = Höhe des Viewports im Layout
Viewport.Width= Breite des Viewports im Layout
ViewPort.CenterPoint = einfach der Mittelpunkt vom Viewport im Layout
ViewPort.ViewHeight = Ist bei einem manuell erstelltem VP gleich dem .Height
ViewPort.ViewDirection = ? benötigt einen 3D Vektor
ViewPort.ViewCenter = Ist bei einem manuell erstelltem VP gleich dem .CenterPoint
ViewPort.ViewTarget = 3d PT ist immer (0,0,0)

wenn ich jetzt manuell einen VP anlege und im Modell auf einen Bereich schaue, mir diese Werte merke wo es ca liegt, dann die Eigenschaften per Code ansehe finde ich aber nirgendswo Koordinaten die denen des Bereichs im Modell irgendwie nahe kommen.

mfg

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

---

Hi,

schau mal >>>das hier<<< (hab jetzt keinen VS-Rechner bei der Hand), da geht's zwar um Drehung, aber die verwendeten Eigenschaften sind ersichtlich.

- alfred -

------------------
www.hollaus.at

---

Hallo!
Danke für den Link, aber wirklich gelöst wurde mein problem damit nicht.

Hier mal mein Code:

Code:

---

Dim vp As Viewport = New Viewport
vp.Width = 200
vp.Height = 100
vp.ViewDirection = Geometry.Vector3d.ZAxis
vp.ViewTarget = New Geometry.Point3d(300, 200, 0)
vp.ViewCenter = New Geometry.Point2d(200, 50)

---

Mein erstes Problem ist, dass das Ansichtsfenster immer so positioniert ist, dass der Mittelpunt genau auf 0,0,0 liegt, egal welche Einstellung ich bei ViewCenter angebe.

Das zweite Problem ist, dass das Fenster glaube ich noch nicht richtig erstellt wird.
Wenn ich z.b einen Doppelklick mache, sollte ich ja ins Modell schauen können.
Das funktioniert aber auch nicht.

Irgendwelche Zeichnungsteile vom Modell kann ich auch noch nicht sehen.
Im Prinzip habe ich ein normales Rechteck ohne Funktion -.-

mfg Frohe Ostern!

Edit:
Hab mich nochmal hingesetzt und habs geschafft, falls jemand das gleiche Problem hat, dieser Code funktioniert bei mir:

Code:

---

Dim vp As Viewport = New Viewport()
vp.SetDatabaseDefaults()
vp.CenterPoint = New Geometry.Point3d(150, 100, 0)
vp.Width = 300
vp.Height = 200             
tLayoutBlDef.AppendEntity(vp)
tTrAct.AddNewlyCreatedDBObject(vp, True)             
vp.ViewDirection = New Geometry.Vector3d(1, 1, 1)             
vp.On = True           
vp.ViewTarget = New Geometry.Point3d(20, 20, 0)
tTrAct.Commit()

---

[Diese Nachricht wurde von veydan am 04. Apr. 2010 editiert.]

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

---

So zur besseren Übersicht, ein neuer Post

Ein Problem gibts jetzt trotzdem noch -.-

bei mir wird der ViewPort immer im Modell erstellt.
hier der Code wo er hinzugefügt wird(gleich nach dem kopieren der Elemente ins leere Layout, dass auch funktioniert)

tLayoutBlDef ist auch das Layout Objekt dass ich beim kopieren der Elemente vom Modell ins leere Layout verwende.

Code:

---

 
tLayoutBlDef.AppendEntity(vp)
tTrAct.AddNewlyCreatedDBObject(vp, True)

---

Muss beim Hinzufügen des ViewPorts das leere Layout aktiv sein?

mfg

[Diese Nachricht wurde von veydan am 06. Apr. 2010 editiert.]

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

---

Hi,

>> bei mir wird der ViewPort immer im Modell erstellt

Wenn das wirklich geht (ein ViewPort im Modellbereich), dann lass mir eine solche Zeichnung bitte zukommen (nachdem Du _AUDIT gemacht hast). Denn sollte das gehen, dann fallen mir eine Menge 'Dummheiten' ein, die man da machen könnte. Ich kann's nur nicht glauben.

>> Muss beim Hinzufügen des ViewPorts das leere Layout aktiv sein?

Nein, denn Du hast ja im Codeschnippsel angegeben, wo dieser ViewPort hinzugefügt werden soll:  tLayoutBlDef.AppendEntity(vp)  und damit sollte eigentlich, wenn tLayoutBlDef auf den Block des Layouts zeigt, klar sein, wo das ViewPort-Objekt hinzugefügt wird. Es muss ja auch nicht der Blockeditor aktiv sein, wenn Du ein Element einem Block hinzufügst.

- alfred -

------------------
www.hollaus.at

---

Ist das ViewTarget Propery der Punkt, der in der Mitte des Viewports liegt?
Bei mir ist die Ansicht immer verschoben.

Meine Berechnung, Rahmen liegt im Modell und innerhalb des Rahmens das gezeichnete.
Dann merk ich mir Position und Größe des Rahmens. Nachdem er im Layout drüben ist, erstelle ich das Ansichsfenster und stelle den ViewTarget genau auf den Mittelwert. Quasi Position.x + Halbe Rahmenbreite und Position.y + Halbe Rahmenhöhe.
dann müsste die Zeichnung genau in das Ansichtsfenster passen.
Tut es nur leider nicht...

edit: hab mir jetzt das COM Objekt der Zeichnung geholt und ein SendCommand( _zoom fe pkt1 pkt2) gemacht, dass funktioniert wunderbar.
mfg

[Diese Nachricht wurde von veydan am 07. Apr. 2010 editiert.]

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

---

Hallo!

Ich möchte bei der Kopierfunktion den "neuen" Rahmen im Layout(der SK soll natürlich dementsprechend mitwandern) gerne auf 0,0,0 haben. Kann ich das über die Matrix steuern? oder muss ich die Objekte nachträglich ändern über das Position Property?

hier nochmal der Code vom kopieren:

Code:

---

                    tLayoutBlDef = CType(tTrAct.GetObject(tLayoutBlDef.ObjectId, DatabaseServices.OpenMode.ForWrite, False, False), DatabaseServices.BlockTableRecord)

                    Dim tCopyColl As DatabaseServices.DBObjectCollection = New DatabaseServices.DBObjectCollection
                    Dim tCopyExtents As DatabaseServices.Extents3d
                    For Each tObjID As DatabaseServices.ObjectId In tSelSetRes.Value.GetObjectIds
                     
                        Dim tDBObj As DatabaseServices.Entity = TryCast(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead, True, True), DatabaseServices.Entity)
                        If tDBObj IsNot Nothing Then
                          
                            Dim tDBObjClone As DatabaseServices.Entity = CType(tDBObj.Clone, DatabaseServices.Entity)

                            tLayoutBlDef.AppendEntity(tDBObjClone)
                            tTrAct.AddNewlyCreatedDBObject(tDBObjClone, True)
                            tCopyColl.Add(tDBObjClone)
                         
                            If tCopyColl.Count = 1 Then
                                tCopyExtents = tDBObjClone.GeometricExtents
                            Else
                                tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MinPoint)
                                tCopyExtents.AddPoint(tDBObjClone.GeometricExtents.MaxPoint)
                            End If
                        End If
                    Next
                   
                    Dim tMoveMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(New Geometry.Vector3d(-tCopyExtents.MinPoint.X, -tCopyExtents.MinPoint.Y, -tCopyExtents.MinPoint.Z))
                    For Each tDBObj As DatabaseServices.Entity In tCopyColl
                        tDBObj.TransformBy(tMoveMat)
                    Next

---

edit:
Wenn ich die Position nachträglich änder, verliere ich vom Schriftkopf die Attribute, diese bleiben an der alten Stelle, obwohl ich das Property Position von der Blockreferenz veränder?!?

mfg

[Diese Nachricht wurde von veydan am 19. Apr. 2010 editiert.]

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

---

Hi,

>> Ich möchte bei der Kopierfunktion den "neuen" Rahmen im Layout(der SK soll natürlich
>> dementsprechend mitwandern) gerne auf 0,0,0 haben.
>> Kann ich das über die Matrix steuern? oder muss ich die Objekte nachträglich ändern
>> über das Position Property?

Wenn das originale Element nicht auf 0,0,0 liegt, dann wird auch die Kopie nicht auf 0,0,0 liegen. Entsprechend wird es notwendig sein, die Elemente zu verschieben. Hast Du eine Vielzahl von Elementen (und erkennst nicht, welches der Rahmen ist), kannst Du ja die Extents der kopierten Elemente zusammenrechnen und dann über den Vektor Extents.Minpoint => 0,0,0 schieben.

>> Wenn ich die Position nachträglich änder, verliere ich vom Schriftkopf die Attribute

Ist normal, wenn Du mit TransformBy der Blockreferenz arbeitest, Du musst die AttributeCollection nachschieben.

HTH, - alfred -

------------------
www.hollaus.at