;;; polyfit.lsp for AutoCAD 14 and AutoCAD 2000 ;;; Funktion POLYFIT ;;; erstellt 2d-Polylinien mit geradlinigen Segmenten ;;; entlang des Verlaufs von gleichmäßig geteilten ebenen Kurven. ;;; ;;; Linien, Kreise, Kreisbögen, Ellipsen, elliptische Bögen, ;;; 2d-Polylinien und 2d-Splines können ausgewählt werden. ;;; Deren Objekthöhe muss Null betragen. ;;; ;;; Es kann gewählt werden, ob die Kurven ;;; in eine bestimmte Anzahl von Abschnitten ;;; oder in Abschnitte von bestimmter Länge geteilt werden sollen ;;; [vgl. AutoCAD-Befehle "Teilen" und "Messen"]. ;;; ;;; Hinweis: ;;; Bei der vorgenommenen Aufteilung werden zwar ;;; die Kurven-Abschnitte gleich lang, aber nicht unbedingt die ;;; daraufhin erstellten Polylinien-Segmente; ;;; je stärker die ursprünglichen Kurven-Abschnitte gekrümmt sind, ;;; umso stärker werden die erzeugten Polylinien-Segmente verkürzt. ;;; ;;; Wenn ein gewähltes Objekt geschlossen ist, ;;; so erstellt POLYFIT eine geschlossene Polylinie; ;;; andernfalls eine offene Polylinie. ;;; ;;; Die Polylinien werden auf dem aktuellen Layer ;;; mit den aktuellen Farb- und Linientypeigenschaften erstellt ;;; [unabhängig von den ursprünglichen Kurven]. ;;; ;;; Durch die Umwandlung von Kurven in Polylinien ;;; wird die Ausführung einiger AutoCAD-Befehle erleichtert ;;; bzw. erst ermöglicht: ;;; - Verbinden mit anderen Objekten, Erstellen geschlossener Objekte ;;; mittels "pedit" ;;; - Extrudieren ;;; - Erstellen von tabellarischen Flächen und Regelflächen ;;; - Markieren umgrenzter Bereiche ;;; beispielsweise für "xclip", "clipit", "extrim", "wipeout" ;;; Außerdem verbessert sich die Kompatibilität beim Export ;;; in andere CAD-Systeme [z. B. frühere AutoCAD-Versionen]. ;;; ;;; Laden der Datei "polyfit.lsp" mit dem Befehl "appload"; ;;; Starten des Programms durch Tastatur-Eingabe "polyfit". ;;; ;;; "polyfit.lsp" wurde aus "Tailors.lsp" entnommen ;;; [http://www.polyface.de/]; ;;; Veränderungen sind in "History.txt" aufgelistet. ;;; ;;; © 2000 Armin Antkowiak, Berlin [info@polyface.de] ;;; Dieses Programm ist freie Software. ;;; Sie können es unter den Bedingungen der GNU General Public License ;;; [wie von der Free Software Foundation herausgegeben] ;;; weitergeben und/oder modifizieren; ;;; entweder unter Version 2 der Lizenz oder - wenn Sie es wünschen - ;;; jeder späteren Version. ;;; Die Veröffentlichung dieses Programms erfolgt in der Hoffnung, ;;; dass es Ihnen von Nutzen sein wird, aber ohne jede Gewähleistung - ;;; sogar ohne die implizite Gewährleistung der Marktreife ;;; oder der Eignung für einen bestimmten Zweck. ;;; Details finden Sie in der GNU General Public License. ;;; Sie sollten eine Kopie der GNU General Public License zusammen ;;; mit diesem Programm erhalten haben [License.txt]. ;;; Falls nicht, schreiben Sie an die Free Software Foundation, Inc., ;;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA; ;;; http://www.fsf.org/copyleft/gpl.html ;;; Function POLYFIT ;;; creates 2D polylines with straight line segments ;;; along equivalently divided length or perimeter of planar curves. ;;; ;;; Lines, circles, arcs, ellipses, 2D polylines, and 2D splines ;;; can be selected. ;;; Their thickness must be equal to zero. ;;; ;;; The user is allowed to choose whether the curves are to be divided ;;; into a certain number of sections ;;; or into sections of a certain length ;;; [cf. AutoCAD "divide" and "measure" commands]. ;;; ;;; Note that a curve gets divided into sections of equal length ;;; but the generated polyline segments differ in length; ;;; the sharper a curve section is bending, the more a generated ;;; polyline segment is shortened. ;;; ;;; If a selected object is closed, POLYFIT will create ;;; a closed polyline. ;;; ;;; The polylines are created on the current layer ;;; with the current color and linetype assignments ;;; [independently of the original curves]. ;;; ;;; The POLYFIT conversion function may assist or enable ;;; execution of various AutoCAD commands: ;;; - joining with other objects, creating closed objects ;;; by means of "pedit" ;;; - extruding ;;; - creating tabulated or ruled surfaces ;;; - marking boundaries of areas, ;;; especially for "xclip", "clipit", "extrim", "wipeout" ;;; Besides, compatibility is improved concerning export ;;; into other CAD systems [especially former AutoCAD versions]. ;;; ;;; Use the "appload" command to load the "polyfit.lsp" file; ;;; type "polyfit" to run the program. ;;; ;;; "polyfit.lsp" was extracted from "Tailors.lsp" ;;; [http://www.polyface.de/]; ;;; modifications are listed in "History.txt". ;;; ;;; © 2000 Armin Antkowiak, Berlin [info@polyface.de] ;;; This program is free software; you can redistribute it ;;; and/or modify it under the terms of the GNU General Public License ;;; as published by the Free Software Foundation; ;;; either version 2 of the License, ;;; or - at your option - any later version. ;;; This program is distributed in the hope that it will be useful, ;;; but without any warranty; without even the implied warranty of ;;; merchantability or fitness for a particular purpose. ;;; See the GNU General Public License for more details. ;;; You should have received a copy of the GNU General Public License ;;; along with this program [License.txt]; ;;; if not, write to the Free Software Foundation, Inc., ;;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA; ;;; http://www.fsf.org/copyleft/gpl.html (if (not (or (wcmatch (ver) "*14*") (wcmatch (ver) "*2000*"))) (princ (if (wcmatch (ver) "*(de)") (strcat "\nDiese Software wurde für AutoCAD 14" " und AutoCAD 2000 entwickelt." "\nDa Sie ein anderes Programm benutzen," " können Fehler auftreten." ) (strcat "\nThis software was developed" " for AutoCAD 14 and AutoCAD 2000." "\nErrors may occur" " because you are using a different program." ) ) ) ) ;______________________________________________________________________; (defun c:polyfit ( / s ; Auswahlsatz der zu bearbeitenden Objekte p ; Auswahlsatz der Teilungspunkte dd ; Länge oder Anzahl der Objekt-Abschnitte [temporär] ; die folgenden Variablen bleiben ; für die nächsten Funktionsaufrufe erhalten: ; *mpolyfit* ; Methode des Aufteilens ; *lpolyfit* ; Länge der Objekt-Abschnitte ; *npolyfit* ; Anzahl der zu erstellenden Abschnitte s# ; Anzahl der zu bearbeitenden Objekte e# ; Index des aktuell bearbeiteten Objekts en ; Elementname ed ; Elementdatenliste et ; Typ des Elements eo ; Flag: Objekt ist offen vd ; für Linien: Richtungsvektor pc ; für Kreise, Bögen und Ellipsen: Mittelpunkt as ; für Ellipsen: Startwinkel ae ; Endwinkel va ; Vektor der großen Halbachse vb ; Vektor der kleinen Halbachse nn ; für Polylinien: Elementname des aktuell bearbeiteten ; Scheitelpunkts el ; Erhebung der Objektebene gegenüber dem WKS-Ursprung vn ; Normalenvektor zur Objektebene ps ; Startpunkt pe ; Endpunkt bzw. aktuell bearbeiteter Punkt p# ; Anzahl der Teilungspunkte i# ; Index des aktuell bearbeiteten Teilungspunkts tt ; temporäres Testflag r14 ; Flag: Release 14 ger ; Flag: deutsche Version tol ; Toleranz echo ; Systemvariable "cmdecho" [command echo] errr ; systemeigene Fehlerbearbeitungs-Routine ) ;| / s ; selection set of objects to be divided p ; selection set of division points dd ; length or number of object sections [temporary] ; the following variables are kept ; for future function calls: ; *mpolyfit* ; method of division ; *lpolyfit* ; length of object sections ; *npolyfit* ; number of object sections s# ; number of objects to be divided e# ; index of object currently worked on en ; entity name ed ; entity data list et ; type of entity eo ; flag: object is open vd ; concerning lines: direction vector pc ; concerning circles, arcs, ellipses: center point as ; concerning ellipses: start angle ae ; end angle va ; vector of major half axis vb ; vector of minor half axis nn ; concerning polylines: entity name of current vertex el ; elevation of object plane above WCS origin vn ; normal vector of object plane ps ; start point pe ; end point or current point p# ; number of division points i# ; index of current division point tt ; temporary test flag r14 ; flag: release 14 ger ; flag: German version tol ; tolerance echo ; "cmdecho" system variable [command echo] errr ; system's error handling routine |; (standardInitiate) (polyfitSelect) (polyfitInput) (polyfitProcess) (standardTerminate) ) ;;; Unterprogramme 1. Ordnung zu POLYFIT ;;; 1st Order Subroutines for POLYFIT (defun polyfitSelect ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger ; set: s s# tt (setq tt t) (while tt (princ (if ger (strcat " - Linien, Kreise, Kreisbögen," " Ellipsen, elliptische Bögen," " 2d-Polylinien, 2d-Splines -" ) (strcat " - lines, circles, arcs, ellipses," " 2D polylines, 2D splines -" ) ) ) (setq s (ssget '( (-4 . "") (-4 . "and>") ; no polygon/polyface meshes (-4 . "") (-4 . "or>") (-4 . "=") (39 . 0.0) ; zero thickness ) ) ) (if s (setq s# (sslength s) tt nil ) (princ (if ger "\nEs wurde keine gültige Auswahl getroffen." "\nNo valid selection made." ) ) ) ) ) (defun polyfitInput ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger tol ; set: dd tt r14 (setq r14 (wcmatch (ver) "*14*")) (if (= "Length" *mpolyfit*) (progn (if (and (numberp *lpolyfit*) (< tol *lpolyfit*)) (progn (setq *lpolyfit* (float *lpolyfit*)) (initget 6 ; positive only (if ger "Länge Anzahl _Length Number" "Length Number") ) (setq dd (getreal (if ger (if r14 (strcat "\n" "aufteilen nach Anzahl/Länge : " ) (strcat "\n" "Länge der Kurven-Abschnitte eingeben " "oder [aufteilen nach Anzahl] : " ) ) (if r14 (strcat "\n" "divide by Number/Length : " ) (strcat "\n" "Enter length of curve sections " "or [divide by Number] : " ) ) ) ) ) ) (progn (initget 7 ; positive only, no null [not just "Enter"] (if ger "Länge Anzahl _Length Number" "Length Number") ) (setq dd (getreal (if ger (if r14 "\naufteilen nach Anzahl/: " (strcat "\n" "Länge der Kurven-Abschnitte eingeben " "oder [aufteilen nach Anzahl]: " ) ) (if r14 "\ndivide by Number/: " (strcat "\n" "Enter length of curve sections " "or [divide by Number]: " ) ) ) ) ) ) ) (cond ( (= "Length" dd) (polyfitInputLength) ) ( (= "Number" dd) (polyfitInputNumber) (setq *mpolyfit* "Number") ) ( (not dd) nil ; default length accepted ) ( t (setq *lpolyfit* dd) ; new length ) ) ) (progn ; (/= "Length" *mpolyfit*) (setq *mpolyfit* "Number") (if (not (numberp *npolyfit*)) (setq *npolyfit* 10)) (setq *npolyfit* (fix *npolyfit*)) (if (or (> 2 *npolyfit*) (< 32766 *npolyfit*)) (setq *npolyfit* 10) ) (setq tt t) (while tt (initget 6 ; positive only (if ger "Länge Anzahl _Length Number" "Length Number") ) (setq dd (getint (if ger (if r14 (strcat "\n" "aufteilen nach Länge/Anzahl : " ) (strcat "\n" "Anzahl der Abschnitte eingeben " "oder [aufteilen nach Länge] : " ) ) (if r14 (strcat "\n" "divide by Length/Number : " ) (strcat "\n" "Enter number of sections " "or [divide by Length] : " ) ) ) ) ) (cond ( (= "Length" dd) (polyfitInputLength) (setq *mpolyfit* "Length" tt nil ) ) ( (= "Number" dd) (polyfitInputNumber) ) ( (not dd) (setq tt nil) ; default number accepted ) ( (or (> 2 dd) (< 32766 dd)) (princ (if ger (strcat "\n" "Die Anzahl muss mindestens 2 " "und höchstens 32766 betragen." ) (strcat "\n" "Minimum number is 2 " "and maximum number is 32766." ) ) ; invalid number, try again ) ) ( t (setq *npolyfit* dd tt nil ; new valid number ) ) ) ) ) ) ) (defun polyfitProcess ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: s# ger r14 tol ; set: p p# i# e# en ed et eo el ps pe pc vd vn va vb as ae nn (setq e# 0) (while (> s# e#) (setq en (ssname s e#) ed (entget en) et (cdr (assoc 0 ed)) ) (cond ( (= "LINE" et) (setq eo t ; open ps (cdr (assoc 10 ed)) ; start point in WCS pe (cdr (assoc 11 ed)) ; end point in WCS vd (mapcar '- pe ps) ; direction vector vn (cdr (assoc 210 ed)) ; extrusion direction ) (if (not (equal 0.0 (scalarProduct vd vn) tol)) (setq vn (normalize (vectorProduct vd (vectorProduct vd vn))) ) ; set vn perpendicular to vd if required ) (setq el (scalarProduct ps vn) ; elevation ps (trans ps 0 vn) ; start point in OCS ps (list (car ps) (cadr ps)) pe (trans pe 0 vn) ; end point in OCS pe (list (car pe) (cadr pe)) ) ) ( (= "CIRCLE" et) (setq eo nil ; closed vn (cdr (assoc 210 ed)) ; extrusion direction pc (cdr (assoc 10 ed)) ; center in OCS el (caddr pc) ; elevation ps (polar pc (getvar "snapang") ; start angle (cdr (assoc 40 ed)) ; radius ) ps (list (car ps) (cadr ps)) ) ) ( (= "ARC" et) (setq eo t ; open vn (cdr (assoc 210 ed)) ; extrusion direction pc (cdr (assoc 10 ed)) ; center in OCS el (caddr pc) ; elevation ps (polar pc (cdr (assoc 50 ed)) ; start angle (cdr (assoc 40 ed)) ; radius ) ps (list (car ps) (cadr ps)) pe (polar pc (cdr (assoc 51 ed)) ; end angle (cdr (assoc 40 ed)) ; radius ) pe (list (car pe) (cadr pe)) ) ) ( (= "ELLIPSE" et) (setq vn (cdr (assoc 210 ed)) ; extrusion direction pc (cdr (assoc 10 ed)) ; center in WCS el (scalarProduct pc vn) ; elevation va (cdr (assoc 11 ed)) ; major half axis in WCS as (cdr (assoc 41 ed)) ; start angle ae (cdr (assoc 42 ed)) ; end angle ) (if (and (= 0.0 as) (= (* 2.0 pi) ae)) (setq eo nil ; closed ps (trans (mapcar '+ pc va) 0 vn ; start point in OCS ) ps (list (car ps) (cadr ps)) ) (setq eo t ; open vb (mapcar '(lambda (c) (* (cdr (assoc 40 ed)) c)) (vectorProduct vn va) ) ; minor half axis in WCS ps (trans (mapcar '+ pc (mapcar '(lambda (c) (* (cos as) c)) va) (mapcar '(lambda (c) (* (sin as) c)) vb) ) 0 vn ; start point in OCS ) ps (list (car ps) (cadr ps)) pe (trans (mapcar '+ pc (mapcar '(lambda (c) (* (cos ae) c)) va) (mapcar '(lambda (c) (* (sin ae) c)) vb) ) 0 vn ; end point in OCS ) pe (list (car pe) (cadr pe)) ) ) ) ( (= "LWPOLYLINE" et) (setq vn (cdr (assoc 210 ed)) ; extrusion dir. el (cdr (assoc 38 ed)) ; elevation ps (cdr (assoc 10 ed)) ; start point ) (if (= 1 (logand 1 (cdr (assoc 70 ed)))) (setq eo nil) ; closed (setq eo t ; open pe (cdr (assoc 10 (reverse ed))) ; end point ) ) ) ( (= "POLYLINE" et) (setq vn (cdr (assoc 210 ed)) ; extrusion direction el (cadddr (assoc 10 ed)) ; elevation nn (entnext en) ps (cdr (assoc 10 (entget nn))) ps (list (car ps) (cadr ps)) ; start point ) (if (= 1 (logand 1 (cdr (assoc 70 ed)))) (setq eo nil) ; closed (progn (setq eo t ; open pe ps ) (while (= "VERTEX" (cdr (assoc 0 (setq ed (entget (setq nn (entnext nn)))) ) ) ) (setq pe (cdr (assoc 10 ed)) pe (list (car pe) (cadr pe)) ; end point ) ) ) ) ) ( t ; (= "SPLINE" et) (setq vn (cdr (assoc 210 ed)) ; extrusion direction ps (trans (cdr (assoc 10 ed)) 0 vn) el (caddr ps) ; elevation ps (list (car ps) (cadr ps)) ; start point ) (if (= 1 (logand 1 (cdr (assoc 70 ed)))) (setq eo nil) ; closed (setq eo t ; open pe (trans (cdr (assoc 10 (reverse ed))) 0 vn) pe (list (car pe) (cadr pe)) ; end point ) ) ) ) (if (= "Length" *mpolyfit*) (command "_.measure" en *lpolyfit*) (command "_.divide" en *npolyfit*) ) (setq p (ssget "_p")) (if (and p (= "POINT" (cdr (assoc 0 (entget (ssname p 0)))))) (progn (setq p# (sslength p) i# p# ed (list (cons 210 vn)) ) (if ; check whether the end point of an open object (and ; is needed to complete the data list eo (not (equal pe (reverse (cdr (reverse (trans (cdr (assoc 10 (entget (ssname p (1- p#))) ) ) 0 vn ) ) ) ) tol ) ) ) (setq ed (cons (cons 10 pe) ed) p# (1+ p#) ) ) (while (< 0 i#) ; include all division points in data list (setq i# (1- i#) pe (trans (cdr (assoc 10 (entget (ssname p i#)))) 0 vn ) ed (cons (list 10 (car pe) (cadr pe)) ed) ) ) (if ; include start point in data list if required (or eo (and (= "Length" *mpolyfit*) (or (/= "POLYLINE" et) (/= 5 (cdr (assoc 70 (entget en)))) ) ) ) (setq ed (cons (cons 10 ps) ed) p# (1+ p#) ) ) (entmake (cons '(0 . "LWPOLYLINE") (cons '(100 . "AcDbEntity") (cons '(100 . "AcDbPolyline") (cons (cons 90 p#) (cons (cons 70 (if eo 0 1)) (cons (cons 38 el) ed) ) ) ) ) ) ) (command "_.erase" p "") ) ) (setq e# (1+ e#)) ) (initget (if ger "Ja Nein _Yes No" "Yes No")) (if (= "Yes" (getkword (if ger (if r14 "\nOriginal-Objekte löschen? Ja/: " "\nOriginal-Objekte löschen? [Ja/Nein] : " ) (if r14 "\nDelete source objects? Yes/: " "\nDelete source objects? [Yes/No] : " ) ) ) ) (command "_.erase" s "") ) ) ;;; Unterprogramme 2. Ordnung für polyfitInput ;;; 2nd order subroutines for polyfitInput (defun polyfitInputLength ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger r14 tol ; set: dd (if (and (numberp *lpolyfit*) (< tol *lpolyfit*)) (progn (setq *lpolyfit* (float *lpolyfit*)) (initget 6) ; positive only (if (setq dd (getreal (strcat "\n" (if ger (if r14 "Länge der Kurven-Abschnitte <" "Länge der Kurven-Abschnitte eingeben <" ) (if r14 "Length of curve sections <" "Enter length of curve sections <" ) ) (rtos *lpolyfit*) ">: " ) ) ) (setq *lpolyfit* dd) ) ) (progn (initget 7) ; positive only, no null [not just "Enter"] (setq *lpolyfit* (getreal (if ger (if r14 "\nLänge der Kurven-Abschnitte: " "\nLänge der Kurven-Abschnitte eingeben: " ) (if r14 "\nLength of curve sections: " "\nEnter length of curve sections: " ) ) ) ) ) ) ) (defun polyfitInputNumber ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger r14 ; set: dd tt (if (not (numberp *npolyfit*)) (setq *npolyfit* 10)) (setq *npolyfit* (fix *npolyfit*)) (if (or (> 2 *npolyfit*) (< 32766 *npolyfit*)) (setq *npolyfit* 10)) (setq tt t) (while tt (initget 6) ; positive only (if (setq dd (getint (strcat "\n" (if ger (if r14 "Anzahl der Abschnitte <" "Anzahl der Abschnitte eingeben <" ) (if r14 "Number of sections <" "Enter number of sections <" ) ) (itoa *npolyfit*) ">: " ) ) ) (if (or (> 2 dd) (< 32766 dd)) (princ (if ger (strcat "\n" "Die Anzahl muss mindestens 2 " "und höchstens 32766 betragen." ) (strcat "\n" "Minimum number is 2 " "and maximum number is 32766." ) ) ; invalid number, try again ) (setq *npolyfit* dd tt nil ; new valid number ) ) (setq tt nil) ; default number accepted ) ) ) ;______________________________________________________________________; ;;; Initialisieren, Terminieren und Fehlerbehandlung ;;; Initiation, termination, and error handling ;; Initialisierende Unterprogramme ;; Initiating subroutines (defun standardInitiate ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; set: ger tol echo errr (setq echo (getvar "cmdecho")) (setvar "cmdecho" 0) (command "_.undo" "_begin") (setq errr *error* *error* standardError ger (wcmatch (ver) "*(de)") tol 1.0e-012 ) ) ;; Terminierendes Unterprogramm ;; Terminating subroutine (defun standardTerminate ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: echo errr (setq *error* errr) (command "_.undo" "_end") (if (equal (ver) "LISP Release 1.0") (command "_.regen") ; IntelliCAD requires this ) ; [compatibility to Tailors.lsp] (setvar "cmdecho" echo) (princ) ) ;; Unterprogramm zur Fehlerbehandlung ;; Error handling subroutine (defun standardError (message) ; The following variables declared in the main routines ; are used within this subroutine: ; get: echo errr (princ message) (setq *error* errr) (command "_.undo" "_end") (setvar "cmdecho" echo) (princ) ) ;______________________________________________________________________; ;;; Allgemein verwendbare Unterprogramme ;;; General-purpose subroutines ;; Normieren eines 3d-Vektors ;; Unter Beibehaltung der Richtung wird die Länge auf 1.0 gesetzt, ;; indem alle drei Komponenten des Vektors ;; durch dessen ursprüngliche Länge dividiert werden. ;; Wird der Nullvektor eingegeben, so wird nil zurückgegeben. ;; Normalize a 3D vector ;; Direction of vector is maintained; its length is set to 1.0 ;; by dividing all three components by original length of vector. ;; The attempt of normalizing a zero vector returns nil. (defun normalize ( v ; Vektor vector / d ; dessen Länge its length tol ; Toleranz tolerance ) (setq tol 1.0e-012 d (distance '(0.0 0.0 0.0) v) ) (if (not (equal 0.0 d tol)) (mapcar '(lambda (c) (/ c d)) v) ) ) ;; Skalarprodukt zweier 3d-Vektoren ;; [ergibt Null genau dann, ;; wenn die Vektoren orthogonal zueinander sind] ;; Scalar product of two 3D vectors ;; [returning zero implies and is implied by ;; both vectors being perpendicular to one another] (defun scalarProduct (v1 v2) (+ (* (car v1) (car v2)) (* (cadr v1) (cadr v2)) (* (caddr v1) (caddr v2)) ) ) ;; Vektorprodukt zweier 3d-Vektoren ;; [ist stets orthogonal zu beiden Vektoren; ;; ist Nullvektor genau dann, wenn beide Vektoren parallel sind] ;; Vector product of two 3D vectors ;; [is always perpendicular to both vectors; ;; returning a zero vector implies and is implied by ;; both vectors being parallel] (defun vectorProduct (v1 v2) (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2))) (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2))) (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2))) ) ) ;______________________________________________________________________; (princ (if (wcmatch (ver) "*(de)") "\n POLYFIT © Armin Antkowiak Oktober 2000" "\n POLYFIT © Armin Antkowiak October 2000" ) ) (princ)