---

Fl_09-N-Profil.dwg

Hallo Forum

Situation:
Ich schreibe für meinen Betrieb ein Lisp, mit welchem Koordinatenrahmen auf den Zeichnungen erstellt werden.
Diese sind sowohl für Vertikale-Pläne (mit Koordinaten von Welt und eigenem BKS) und auch für Senkrechte-Pläne.
Die Senkrechten-Pläne sind auf einem BKS das auch senkrecht zu Welt steht.
Die Koordinaten die am Rahmen angeschrieben werden, sollen aber entweder als Welt-Koordinaten oder aber als BKS-Koordinaten vom Vertikalen-BKS (!) angeschrieben werden.

Schwierigkeit:
Soweit so gut. Probleme machen mir die Senkrechten.
Da ich die Koordinaten für den Rahmen im Senkrechten-BKS bekomme, sie zur korrekten Berechnung der geraden Koordinaten und der Abstände aber in das Vertikale-BKS umrechnen muss und sie am Schluss, um die Linien mit Entmake zu erstellen, in Welt haben muss, ich die Koordinaten aber auch noch immer im Vertikalen abgreifen können muss um den Text zu beschriften, brauche ich eine möglichst Flexible/häufig anwendbare Transformation.

Erste Lösung:
Ich habe im Internet natürlich schon einiges gesucht und habe das hier gefunden:

Code:

---

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;
;;;  Befehl:    MVX / TransFromWCS / TRP / TransToWCS
;;;  Zweck:      Umrechnungsmatrix zwischen BKS und Welt
;;;  Funktionen: Keine Unterfunktionen
;;;  Autor:      MVX - Vladimir Nesterovsky - TransFromWCS / TRP / TransToWCS - Doug Wilson
;;;  URL:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/usage-of-the-trans-function/td-p/9038723
;;;  Datum:      -
;;;  Argumente:  MVX:  M  --> Matrix
;;;                    V  --> Vector
;;;              TransFromWCS:  Pt  --> Punkt
;;;                            Mat  --> Trasformationsmatrix
;;;                            Org  --> Ursprungskoordinaten vom UCS in WCS
;;;              TRP:  M  -->  Matrix
;;;              TransToWCS:  Pt  --> Punkt
;;;                          Mat  --> Trasformationsmatrix
;;;                          Org  --> Ursprungskoordinaten vom UCS in WCS
;;;  Variablen:  -
;;;  Func-Key:  R
;;;  Code:
    (defun MXV ( M V / R )
      (mapcar
        (function (lambda (R) (apply '+ (mapcar '* R V))))
        M
      );end mapcar
    );end defun

    (defun TransFromWCS ( Pt Mat Org / )
      (MXV Mat (mapcar '- Pt Org))
    );end defun

    (defun TRP ( M / ) (apply 'mapcar (cons 'list M)))

    (defun TransToWCS (Pt Mat Org)
      (mapcar '+ (MXV (TRP Mat) Pt) Org)
    );end defun

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

---

Und habe mir das dann noch etwas weiter zusammen gesetzt:

Code:

---

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

    (defun TransFlex ( Pt / PrUCS CoUCS )
      (setq PrUCS (tblsearch "UCS" (cadr UCS))
            CoUCS (tblsearch "UCS" (car UCS))
            Pt (TransToWCS
                Pt
                (list (cdr (assoc 11 PrUCS))(cdr (assoc 12 PrUCS))(cdr (assoc 10 PrUCS)))
                (cdr (assoc 10 PrUCS))
              );end TransToWCS
      );end setq
      (if
        (/= (car UCS) "Welt")
          (setq Pt (TransFromWCS
                    Pt
                    (list (cdr (assoc 11 CoUCS))(cdr (assoc 12 CoUCS))(cdr (assoc 10 CoUCS)))
                    (cdr (assoc 10 CoUCS))
                  );end TransFromWCS
          );end setq
      );end if
      Pt
    );end defun

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

---

Hiermit (und den einzeln angewandten Funktionen oben) habe ich aber das Problem, dass die Koordinaten nach mehrfachem Transformieren nicht mehr stimmen.
Gerade die Z-Koordinate, die für mich sehr Wichtig ist, ist so dann komplett falsch.

Zweite Lösung:
Als zweites habe ich versucht ein Workaround zu bauen um das klassische Trans zu benutzen:

Code:

---

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

    (defun TransFlex ( Pt / ;|PrUCS CoUCS|; )
      (if
        (/= (getvar "UCSNAME")(cadr UCS))
          (command "._UCS" "_NAMED" "_RESTORE" (cadr UCS))
      );end if
      (setq Pt (trans Pt 1 0))
      (if
        (/= (car UCS) "Welt")
          (progn
            (if
              (/= (getvar "UCSNAME")(car UCS))
                (command "._UCS" "_NAMED" "_RESTORE" (car UCS))
            );end if
            (setq Pt (trans Pt 0 1))
          );end progn
      );end if
      Pt
    );end defun

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

---

Das funktioniert zwar und gibt mir stehts die korrekten Koordinaten, ist aber durch den dauerhaften Wechsel des BKS mit command in der Anwendung mit Schlaufen sehr ineffizient.

Frage:
Habe ich bei der Ersten Lösung einfach einen Fehler in der Anwendung gemacht?
Ist das Grundsätzlich schwierig oder gibt es da eine andere Lösung die ich noch nicht gefunden habe?

Ich bin selber nicht wirklich in der Materie wenn es um Vektoren, Matrixen oder diesen "Arbitrary Axis Algorithm" geht. 

Im Anhang eine .dwg mit allen BKSs -/ 2022-02 = Vertikales, Fl_09-N-Profil = Senkrechtes /-

Wäre für Tipps und Hilfen sehr Dankbar!
Vielen Dank im Voraus und einen Schönen Morgen/Mittag/Abend

------------------
___________________________________________

Bubi spiele, Bubi glücklich!

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

---

Hallo Bubi,

nur mal als Rückfrage, afkoord bzw. Koordinatenbeschriftung für Ansichtsfesnter kennst Du? Ich habe jetzt nicht probiert, wie es mit Fenstern mit Benutzer-Koords umgeht, aber eine Versuch wäre es ja mal wert.

Gruß
Thomas

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

---

Ich bin am Anfang meiner Recherchen auf afKoord gestossen und habe es mir dort auch kurz angeschaut.
Es war mir aber zu unübersichtlich aufgebaut und da es die Linien und die Beschriftung noch dazu mit Command erstellt (womit wir wider bei der Performance wären) wollte ich nicht mehr Zeit darin investieren.

Wenn ich es beim jetzigen überfliegen richtig gesehen habe, muss dort auch nicht gross transformiert werden, weil Command ja auch BKS Koordinaten nimmt.

------------------
___________________________________________

Bubi spiele, Bubi glücklich!

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

---

Also es ist nicht so als ob ich das Problem inzwischen verstanden habe, aber ich habe ein neuen Workaround gefunden, der die Aufgabe für mich erfüllt.

Code:

---

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;
;;;  Befehl:     TransFlex
;;;  Zweck:      Umrechnung der Koordinaten von und zu belibigen BKS
;;;  Funktionen: (MXV . 2)
;;;              (TRP . 1)
;;;              (TRANSFROMWCS . 3)
;;;              (TRANSTOWCS . 3)
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt
;;;  Datum:      2022/März
;;;  Argumente:  Pt    --> Koordinaten-Punkt
;;;              From  --> Koordinaten sind im BKS ("World" "Flex" "Profil")
;;;              To    --> Koordinaten werden zu BKS ("World" "Flex" "Profil")
;;;  Variablen:  PrUCS  --> Dictionary zu Profil-BKS
;;;              GrUCS  --> Dictionary zu Grabungs-BKS
;;;  Code:
  (defun TransFlex ( Pt From To / PrUCS CoUCS )
  ;;; Begin nach den def's der Unterfunktionen

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;
;;;  Befehl:     MVX / TransFromWCS / TRP / TransToWCS
;;;  Zweck:      Umrechnungsmatrix zwischen BKS und Welt
;;;  Funktionen: Keine Unterfunktionen
;;;  Autor:      MVX - Vladimir Nesterovsky - TRP / TransFromWCS / TransToWCS - Doug Wilson
;;;  URL:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/usage-of-the-trans-function/td-p/9038723
;;;  Datum:      -
;;;  Argumente:  MVX:  M  --> Matrix
;;;                    V  --> Vector
;;;              TRP:  M  --> Matrix
;;;              TransFromWCS:  Pt   --> Punkt
;;;                             Mat  --> Trasformationsmatrix
;;;                             Org  --> Ursprungskoordinaten vom UCS in WCS
;;;              TransToWCS:  Pt   --> Punkt
;;;                           Mat  --> Trasformationsmatrix
;;;                           Org  --> Ursprungskoordinaten vom UCS in WCS
;;;  Variablen:  -
;;;  Func-Key:   R
;;;  Code:
    (defun MXV ( M V / R )
      (mapcar
        (function (lambda (R) (apply '+ (mapcar '* R V))))
        M
      );end mapcar
    );end defun

    (defun TRP ( M / ) (apply 'mapcar (cons 'list M)))

    (defun TransFromWCS ( Pt Mat Org / )
      (MXV Mat (mapcar '- Pt Org))
    );end defun

    (defun TransToWCS ( Pt Mat Org / )
      (mapcar '+ (MXV (TRP Mat) Pt) Org)
    );end defun

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;
;;; Weiter mit TransFlex
    (setq PrUCS (tblsearch "UCS" (cadr UCS))
          GrUCS (tblsearch "UCS" (car UCS))
          Pt (cond
               ((= From "Profil")
                 (TransToWCS
                   Pt
                   (list (cdr (assoc 11 PrUCS))(cdr (assoc 12 PrUCS))(cdr (assoc 10 PrUCS)))
                   (cdr (assoc 10 PrUCS))
                 );end TransToWCS
               );end
               ((= From "Flex")
                 (if
                   (/= (car UCS) "Welt")
                     (list
                       (car
                         (TransToWCS
                           Pt
                           (list (cdr (assoc 11 GrUCS))(cdr (assoc 12 GrUCS)))
                           (cdr (assoc 10 GrUCS))
                         );end TransFromWCS
                       );end car
                       (cadr
                         (TransToWCS
                           Pt
                           (list (cdr (assoc 11 GrUCS))(cdr (assoc 12 GrUCS)))
                           (cdr (assoc 10 GrUCS))
                         );end TransFromWCS
                       );end cadr
                       (caddr Pt)
                     );end list
                   Pt
                 );end if
               );end
               ((= From "World") Pt)
             );end cond
          Pt (cond
               ((= To "Flex")
                 (if
                   (/= (car UCS) "Welt")
                     (list
                       (car
                         (TransFromWCS
                           Pt
                           (list (cdr (assoc 11 GrUCS))(cdr (assoc 12 GrUCS)))
                           (cdr (assoc 10 GrUCS))
                         );end TransFromWCS
                       );end car
                       (cadr
                         (TransFromWCS
                           Pt
                           (list (cdr (assoc 11 GrUCS))(cdr (assoc 12 GrUCS)))
                           (cdr (assoc 10 GrUCS))
                         );end TransFromWCS
                       );end cadr
                       (caddr Pt)
                     );end list
                   Pt
                 );end if
               );end
               ((= To "Profil")
                 (list
                   (car
                     (TransFromWCS
                       Pt
                       (list (cdr (assoc 11 PrUCS))(cdr (assoc 12 PrUCS)))
                       (cdr (assoc 10 PrUCS))
                     );end TransFromWCS
                   );end car
                   (cadr
                     (TransFromWCS
                       Pt
                       (list (cdr (assoc 11 PrUCS))(cdr (assoc 12 PrUCS)))
                       (cdr (assoc 10 PrUCS))
                     );end TransFromWCS
                   );end cadr
                   '0.0
                 );end list
               );end
               ((= To "World") Pt)
             );end cond
    );end setq
    Pt
  );end defun

;;;-----------------------------------------------------------------------------------------------------------------------------------;;;

---

Der Fehler scheint bei der Transformation der Z-Koordinaten zu liegen. Diese konnte bei mir nie korrekt umgewandelt werden.
Glücklicherweise werden bei meinen Vertikalen-BKSen Y und Z getauscht. Meine BKS haben also ihren Y-Ursprung auf Welt-Z-0 und somit kann ich die Koordinaten "manuell" nachreichen.

Sicher keine sehr elegante Lösung, aber immerhin erledigt sie die Arbeit die ich ihr gebe.  

------------------
___________________________________________

Bubi spiele, Bubi glücklich!

[Diese Nachricht wurde von Archäologie Bubi am 07. Mrz. 2022 editiert.]

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

---

Ich habe mich nach über einem Jahr nochmals an mein damaliges Problem gesetzt, welches ich für mich nie befriedigend abgeschlossen habe.

Dank meinem inzwischen besseren Verständnis und vor allem dank gewissen, sehr viel schlaueren, Leuten, habe ich nun eine Lösung zusammen bekommen, welche die Koordinaten korrekt umrechnet, ohne das ich irgendwelche Änderungen auf gut Glück vornehmen muss.

Daher nochmals ein spezielles Dankeschön an die Herausgeber der Funktionen zur Berechnung der Vektoren und Matrix etc.:
Lee Mac; Vladimir Nesterovsky; Marko Ribar

Im Folgenden der Code, falls andere auf ähnliche Probleme stossen.
Beachtet: Winkel zwischen X- und Y-Achse muss für eine Korrekte Umrechnung immer 90°Grad sein.

Die Argumente From und To bilden sich aus den Group Codes 10, 11 & 12.
Diese Group Codes können auch berechnet werden, das BKS muss also nicht existieren damit der Punkt umgerechnet werden kann.

Code:

---

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     L-CoordFrame |-> TransFlex ;;;
;;;  Zweck:      Umrechnung von Koordinaten von und zu beliebigen BKS ;;;
;;;              Wichtig: Winkel zwischen X- und Y-Achse muss für eine Korrekte Umrechnung immer 90°Grad sein. ;;;
;;;  Funktionen: (V^V . 2) ;;;
;;;              (UNIT . 1) ;;;
;;;              (MXV . 2) ;;;
;;;              (TRANSTO . 5) ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2023/September ;;;
;;;  Argumente:  Pt    --> Koordinaten-Punkt der Umgewandelt werden soll ;;;
;;;              From  --> Angaben des Start-BKS als Liste mit: (10 Uhrsprung)(11 X-Achse)(12 Y-Achse) ;;;
;;;              To    --> Angaben des Ziel-BKS als Liste mit: (10 Uhrsprung)(11 X-Achse)(12 Y-Achse) ;;;
;;;  Variablen:  - ;;;
;;;  Code:
  (defun TransFlex ( Pt From To / ); Begin nach den def's der Unterfunktionen

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     L-CoordFrame |-> TransFlex |-> v^v ;;;
;;;  Zweck:      Vector Cross Product ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Lee Mac / Lee Mac Programming ;;;
;;;  URL:        http://www.lee-mac.com/mathematicalfunctions.html ;;;
;;;  Datum:      -/- ;;;
;;;  Argumente:  u,v  --> Vectors in R^3 ;;;
;;;  Code:
    (defun v^v ( u v / )
      (list (- (* (cadr u)(caddr v))(* (cadr v)(caddr u)))
            (- (* (car v)(caddr u))(* (car u)(caddr v)))
            (- (* (car u)(cadr v))(* (car v)(cadr u)))
      );end list
    );end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     L-CoordFrame |-> TransFlex |-> unit ;;;
;;;  Zweck:      Unit Vector (R^n) ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Marko Ribar, d.i.a. ;;;
;;;  URL:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/usage-of-the-trans-function/td-p/9038723 ;;;
;;;  Datum:      -/- ;;;
;;;  Argumente:  v  --> Vectors in R^n ;;;
;;;  Func-Key:   x ;;;
;;;  Code:
    (defun unit ( v / x )
      (mapcar '(lambda ( x )(/ x (distance '(0.0 0.0 0.0) v))) v)
    );end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     L-CoordFrame |-> TransFlex |-> mxv ;;;
;;;  Zweck:      Matrix x Vector ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Vladimir Nesterovsky ;;;
;;;  URL:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/usage-of-the-trans-function/td-p/9038723 ;;;
;;;  Datum:      -/- ;;;
;;;  Argumente:  m  --> nxn Matrix ;;;
;;;              v  --> Vectors in R^n ;;;
;;;  Func-Key:   r ;;;
;;;  Code:
    (defun mxv ( m v / r )
      (mapcar '(lambda ( r )(apply '+ (mapcar '* r v))) m)
    );end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     L-CoordFrame |-> TransFlex |-> TransTo ;;;
;;;  Zweck:      Umrechnen der Koordinaten mit Ursprung, X-Achse und Y-Achse ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Marko Ribar, d.i.a. ;;;
;;;              Angepasst: Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  URL:        https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/usage-of-the-trans-function/td-p/9038723 ;;;
;;;  Datum:      -/- ;;;
;;;              Angepasst: 2023/September ;;;
;;;  Argumente:  Pt    --> Koordinaten-Punkt der Umgewandelt werden soll ;;;
;;;              Org   --> Ursprung ;;;
;;;              xDir  --> X-Achsen Vektor ;;;
;;;              yDir  --> Y-Achsen Vektor ;;;
;;;              Mode  --> Modus (T or nil) zur Verkürzung der Eingabe ;;;
;;;  Code:
    (defun TransTo ( Pt Org xDir yDir Mode / )
      (mxv (list (unit (mapcar '- (if Mode (mapcar '+ Org xDir) xDir) Org))
                 (unit (mapcar '- (if Mode (mapcar '+ Org yDir) yDir) Org))
                 (unit (v^v (mapcar '- (if Mode (mapcar '+ Org xDir) xDir) Org)
                            (mapcar '- (if Mode (mapcar '+ Org yDir) yDir) Org)
                       );end v^v
                 );end unit
           );end list
           (mapcar '- Pt Org)
      );end mxv
    );end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;; Weiter mit TransFlex
    (setq Pt (TransTo Pt
                      (TransTo '(0.0 0.0 0.0)(cdr (assoc 10 From))(cdr (assoc 11 From))(cdr (assoc 12 From)) T)
                      (TransTo '(1.0 0.0 0.0)(cdr (assoc 10 From))(cdr (assoc 11 From))(cdr (assoc 12 From)) T)
                      (TransTo '(0.0 1.0 0.0)(cdr (assoc 10 From))(cdr (assoc 11 From))(cdr (assoc 12 From)) T)
                      nil
             );end TransTo
          Pt (TransTo Pt (cdr (assoc 10 To))(cdr (assoc 11 To))(cdr (assoc 12 To)) T)
    );end setq
  );end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;

---

------------------

Bubi spiele, Bubi glücklich!

[Diese Nachricht wurde von Archäologie Bubi am 19. Sep. 2023 editiert.]

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

---

ACHTUNG! Du antwortest auf einen Beitrag der älter als 1 Jahr ist!

Die Funktionsweise meines letzten Posts ist zwar erfolgreich, allerdings etwas Umständlich in der Ausführung.
Da ich für eines meiner Tools den Code wieder benötigt habe, die Sammlung der benötigten Infos unter den gegeben Umständen aber etwas umständlich war, habe ich dies zum Anlass genommen, die Funktion nochmals genauer zu betrachten und zu optimieren.

Das Ergebnis daraus ist IMO einiges einfacher in der Anwendung und kann vielleicht auch Anderen nützlich sein, daher will ich das hier natürlich nicht vorenthalten:

Code:

---

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:    FB|VL ;;;
;;;  Zweck:      Auslesen und umwandeln einer Safearray-Angabe eines vla-objects zu eine Liste ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2025/November ;;;
;;;  Argumente:  Cmd  --> vla-Command zum abfragen der Safearray-Angabe ;;;
;;;              Obj  --> vla-object das abgefragt werden soll ;;;
;;;  Variablen:  - ;;;
;;;  Code:
(defun FB|VL ( Cmd Obj / )(vlax-safearray->list (vlax-variant-value (Cmd Obj))))

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:    FB|TFX ;;;
;;;  Zweck:      Flexibles transformieren zwischen UCS ohne diese zu aktivieren ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2025/November ;;;
;;;  Argumente:  PtL  --> Koordinatenpunkt oder -liste ;;;
;;;              Frm  --> Ausgangs UCS des Koordinatenpunkts: ;;;
;;;              0 = WCS, 1 = activeUCS, UCS-Name, EName oder vla-object ;;;
;;;              To  --> Ziel UCS des Koordinatenpunkts: ;;;
;;;              0 = WCS, 1 = activeUCS, UCS-Name, EName oder vla-object ;;;
;;;  Variablen:  Mtx  --> 3x4 Matrix des UCS ;;;
;;;              Rtn  --> Rückgabe des/der transformierten Koordinatenpunkt/-liste ;;;
;;;  Func-Keys:  p ;;;
;;;              m ;;;
;;;  Code:
(defun FB|TFX ( PtL Frm To / Mtx Rtn p m )
  (if (setq Frm (cond ((and (eq (type Frm)'INT)(= Frm 1)
                            (not (vl-catch-all-error-p (setq Frm (vl-catch-all-apply 'vla-get-ActiveUCS (list (vla-get-ActiveDocument (vlax-get-acad-object)))))))
                      );end and
                        Frm
                      );end
                      ((and (eq (type Frm)'STR)(tblobjname "UCS" Frm))(vlax-ename->vla-object (tblobjname "UCS" Frm)))
                      ((and (eq (type Frm)'ENAME)(eq (cdr (assoc 0 (entget Frm))) "UCS"))(vlax-ename->vla-object Frm))
                      ((and (eq (type Frm)'VLA-OBJECT)(eq (vla-get-ObjectName Frm) "AcDbUCSTableRecord")) Frm)
                      ((and (eq (type Frm)'VLA-OBJECT)(eq (vla-get-ObjectName Frm) "AcDbViewport")(assoc 345 (entget (vlax-vla-object->ename Frm))))
                        (vlax-ename->vla-object (cdr (assoc 345 (entget (vlax-vla-object->ename Frm)))))
                      );end
                );end cond
      );end setq
      (setq Mtx (reverse (cdr (reverse (FB|VL vla-GetUCSMatrix Frm))))
            Rtn (mapcar '(lambda ( p )(mapcar '+ (mapcar '(lambda ( m )(apply '+ (mapcar '* m p))) Mtx)(mapcar 'last Mtx)))
                        (if (vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(list PtL) PtL)
                );end mapcar
      );end setq
  );end if
  (if (setq To (cond ((and (eq (type To)'INT)(= To 1)
                          (not (vl-catch-all-error-p (setq To (vl-catch-all-apply 'vla-get-ActiveUCS (list (vla-get-ActiveDocument (vlax-get-acad-object)))))))
                      );end and
                        To
                    );end
                    ((and (eq (type To)'STR)(tblobjname "UCS" To))(vlax-ename->vla-object (tblobjname "UCS" To)))
                    ((and (eq (type To)'ENAME)(eq (cdr (assoc 0 (entget To))) "UCS"))(vlax-ename->vla-object To))
                    ((and (eq (type To)'VLA-OBJECT)(eq (vla-get-ObjectName To) "AcDbUCSTableRecord")) To)
                    ((and (eq (type To)'VLA-OBJECT)(eq (vla-get-ObjectName To) "AcDbViewport")(assoc 345 (entget (vlax-vla-object->ename To))))
                        (vlax-ename->vla-object (cdr (assoc 345 (entget (vlax-vla-object->ename To)))))
                    );end
              );end cond
      );end setq
      (setq Mtx (reverse (cdr (reverse (FB|VL vla-GetUCSMatrix To))))
            Rtn (mapcar '(lambda ( p )(mapcar '(lambda ( m )(apply '+ (mapcar '* m (mapcar '- p (mapcar 'last Mtx)))))
                                              (apply 'mapcar (cons 'list (mapcar '(lambda ( m )(mapcar '+ m '(0. 0. 0.))) Mtx)))
                                      );end mapcar
                        );end lambda
                        (if Rtn Rtn (if (vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(list PtL) PtL))
                );end mapcar
      );end setq
  );end if
  (cond ((null Rtn) PtL)
        ((vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(car Rtn))
        (t Rtn)
  );end cond
);end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;

---

------------------
Bubi spiele, Bubi glücklich!

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

---

Für das gleiche Projekt habe ich auch eine zuverlässige Möglichkeit zur Transformation zwischen PSpace und MSpace gebraucht.
Normalerweise bietet die Trans-Funktion mit den Argumenten 2 & 3 auch dies, allerdings musste ich Feststellen, dass PViewport-Werte wie "Target" von ACAD nicht immer Korrekt nachgeführt werden.
Dies wird wohl auch beim ACAD eigenen Command wie _.CHSPACE/BERCHWECHS nicht korrekt behandelt und resultiert in einem fehlerhaften Übertrag.

Ich habe in folgendem Code versucht dem gegenzusteuern und die Transformation (vor allem bei senkrechten UCS) zu korrigieren:

Code:

---

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     FB|VL ;;;
;;;  Zweck:      Auslesen und umwandeln einer Safearray-Angabe eines vla-objects zu eine Liste ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2025/November ;;;
;;;  Argumente:  Cmd  --> vla-Command zum abfragen der Safearray-Angabe ;;;
;;;              Obj  --> vla-object das abgefragt werden soll ;;;
;;;  Variablen:  - ;;;
;;;  Code:
(defun FB|VL ( Cmd Obj / )(vlax-safearray->list (vlax-variant-value (Cmd Obj))))

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     FB|MSP ;;;
;;;  Zweck:      Stellt sicher, dass der korrekte MSpace vor dem Ausführen einer Funktion aktiv ist ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2025/November ;;;
;;;  Argumente:  PVp  --> vla-object des modifizierten PViewport ;;;
;;;              Fnc  --> Funktion die dazwischen evaluiert werden soll ;;;
;;;  Variablen:  Doc  --> AutoCAD Active-Document-Object ;;;
;;;              PVw  --> Zwischenspeicher des MSpace-Status zur Wiederherstellung ;;;
;;;              Rtn  --> Zwischenspeicher der Fnc-Ausgabe zur Abschlussausgabe ;;;
;;;  Code:
(defun FB|MSP ( PVp Fnc / Doc PVw Rtn )
  (if (setq PVw (eq (vla-get-MSpace (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object)))) :vlax-false))
      (vl-catch-all-apply 'vla-put-MSpace (list Doc :vlax-true))
  );end if
  (if (/= (vla-get-ObjectID (vla-get-ActivePViewport Doc))(vla-get-ObjectID Obj))(vl-catch-all-apply 'vla-put-ActivePViewport (list Doc PVp)))
  (setq Rtn (eval Fnc))
  (if PVw (vl-catch-all-apply 'vla-put-MSpace (list Doc :vlax-false)))
  Rtn
);end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;
;;;  Befehl:     FB|TYL ;;;
;;;  Zweck:      Korrigierte Transformation zwischen Modell & Papierbereich / Papierbereich & Modell ;;;
;;;  Funktionen: Keine Unterfunktionen ;;;
;;;  Autor:      Fabian Bubendorf / Archäologische Bodenforschung Basel-Stadt ;;;
;;;  Datum:      2025/November ;;;
;;;  Argumente:  PtL  --> Koordinatenpunkt oder -liste ;;;
;;;              Frm  --> vla-object des PViewport wenn PtL in MSpace nil wenn PtL in PSpace ;;;
;;;              To   --> vla-object des PViewport wenn PtL in PSpace nil wenn PtL in MSpace ;;;
;;;  Variablen:  Rtn  --> Rückgabe des/der transformierten Koordinatenpunkt / -liste ;;;
;;;  Func-Keys:  val ;;;
;;;  Code:
(defun OTF|TLY ( PtL Frm To / Rtn val )
  (setq Rtn (FB|MSP (if Frm Frm To)
                    '(cond (Frm (mapcar '(lambda ( val )
                                           (mapcar '(lambda ( val )(if (equal val 0. 1e-6) 0. val))
                                                   (mapcar '- (trans (trans (trans (mapcar '+ val (list 0. 0. (last (trans (trans (trans (FB|VL vla-get-Target Frm) 3 2) 2 0) 0 1)))) 1 0) 0 2) 2 3)
                                                              (list 0. 0. (last (FB|VL vla-get-Target Frm)))
                                                   );end mapcar
                                           );end mapcar
                                         );end lambda
                                        (if (vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(list PtL) PtL)
                                );end mapcar
                           );end
                           (To (mapcar '(lambda ( val )
                                          (mapcar '(lambda ( val )(if (equal val 0. 1e-6) 0. val))
                                                  (mapcar '- (trans (trans (trans val 3 2) 2 0) 0 1)
                                                             (list 0. 0. (last (trans (FB|VL vla-get-Target To) 0 1)))
                                                  );end mapcar
                                          );end mapcar
                                        );end lambda
                                       (if (vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(list PtL) PtL)
                               );end mapcar
                           );end
                     );end cond
            );end FB|MSP
  );end setq
  (if (vl-catch-all-error-p (vl-catch-all-apply 'caar (list PtL)))(car Rtn) Rtn)
);end defun

;;; --==*==-- ------------------------------------------------- --==*==-- --=={ ABBS }==-- --==*==-- ------------------------------------------------- --==*==-- ;;;

---

In meinen Testserien konnte ich die Transformationen hiermit immer korrekt berechnen.
Kann aber nicht ausschliessen, dass hier noch weitere Punkte mit reinspielen, die ich noch nicht erkannt oder verstanden habe...

------------------
Bubi spiele, Bubi glücklich!

[Diese Nachricht wurde von Archäologie Bubi am 04. Dez. 2025 editiert.]

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