;;; iron.lsp for AutoCAD 14 and AutoCAD 2000 ;;; Funktion BÜGELN ;;; bringt Objekte, welche für eine 2d-Zeichnung vorgesehen sind, ;;; in eine Ebene. ;;; ;;; BÜGELN verschiebt bzw. projiziert die ausgewählten ;;; Punkte, Konstruktionslinien, Strahlen, Linien, Kreise, Bögen, ;;; Ellipsen, 2d-Polylinien, 2d- und 3d-Splines in ein und dieselbe ;;; Ebene, die parallel zur xy-Ebene des aktuellen BKS liegt. ;;; ;;; Die gewünschte Höhe der Ebene [z-Koordinate im aktuellen BKS] ;;; kann bestimmt werden durch das Eingeben des Zahlenwerts ;;; per Tastatur oder durch das Anklicken eines Punktes, ;;; der bereits die richtige Z-Koordinate besitzt. ;;; Voreingestellt ist z = 0. ;;; ;;; Die Verschiebung bzw. Projektion erfolgt senkrecht zur xy-Ebene. ;;; Die z-Koordinaten werden angepasst, jedoch sämtliche x- und y- ;;; Koordinaten im aktuellen BKS bleiben erhalten. ;;; ;;; Konstruktionslinien, Strahlen und Linien werden allerdings ;;; nicht verändert, wenn sie senkrecht zur xy-Ebene stehen; ;;; Kreise, Bögen, Ellipsen, 2d-Polylinien und 2d-Splines werden ;;; nur dann verändert, wenn sie bereits parallel zur xy-Ebene sind; ;;; denn andernfalls geht BÜGELN davon aus, ;;; dass die aktuelle Lage der Objekte den Benutzerwünschen entspricht ;;; ["im Zweifel für den Angeklagten"]. ;;; Deshalb bleiben auch 3d-Polylinien, 3d-Flächen, Netze, Regionen ;;; und andere 3d-Objekte unangetastet. ;;; [Mit den AutoCAD-Befehlen "Kreis", "Bogen", "Ellipse" und "Plinie" ;;; entstehen von vornherein nur Objekte, die parallel zur xy-Ebene ;;; des aktuellen BKS sind. ;;; Anders beim Befehl "Spline"; ein versehentliches Erzeugen ;;; von 3d-Splines ist leicht möglich.] ;;; ;;; Objekte mit einer von Null verschiedenen Objekthöhe ;;; können nicht ausgewählt werden. ;;; Objekte auf gesperrten Layern werden generell nicht verändert. ;;; Auch Schraffuren, Bemaßungen und Texte sowie Objekte in Blöcken ;;; bleiben unbehandelt. ;;; ;;; Laden der Datei "iron.lsp" mit dem Befehl "appload"; ;;; Starten des Programms durch Tastatur-Eingabe "bügeln". ;;; ;;; "iron.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 IRON ;;; puts objects onto a plane intended for a 2D drawing. ;;; ;;; IRON moves or projects the selected points, xlines, rays, lines, ;;; circles, arcs, ellipses,2D polylines, 2D and 3D splines ;;; onto the same plane parallel to the current UCS XY plane. ;;; ;;; The desired elevation of the plane [Z coordinate in current UCS] ;;; may be defined by entering the Z value on the keyboard ;;; or by specifying a point that already has the right Z coordinate. ;;; Default value is Z = 0. ;;; ;;; The translation or projection direction is perpendicular ;;; to the XY plane. ;;; Z coordinates get modified; ;;; but all X and Y coordinates in current UCS are maintained. ;;; ;;; Xlines, rays, and lines will not be changed if they are ;;; perpendicular to the XY plane; ;;; circles, arcs, ellipses, 2D polylines and 2D splines ;;; will only be changed if they are parallel to the XY plane already; ;;; oterwise IRON considers their current positions ;;; as being corresponding to user's wishes ;;; ["in dubio pro reo"]. ;;; This is also the reason why 3D polylines, 3D faces, meshes, ;;; regions, and other 3D objects are filtered out from selection. ;;; [From the start, the "circle", "arc", "ellipse" and "pline" ;;; commands always create objects parallel ;;; to the current UCS XY plane. ;;; On the other hand, the "spline" command easily may create ;;; 3D splines by mistake.] ;;; ;;; Objects with non-zero thickness are excluded from selection. ;;; Objects on locked layers generally do not get modified. ;;; IRON has no effect on hatches, dimensions, texts, and blocks. ;;; ;;; Use the "appload" command to load the "iron.lsp" file; ;;; type "iron" to run the program. ;;; ;;; "iron.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:bügeln ( / s ; Auswahlsatz zz ; gewünschte z-Koordinate im aktuellen BKS s# ; Anzahl der gewählten Objekte ; [auf nicht gesperrten Layern] l# ; Anzahl der gewählten Objekte auf gesperrten Layern m# ; Anzahl der Elemente, die während der Bearbeitung ; verändert wurden e# ; Index des aktuell bearbeiteten Elements en ; Elementname ed ; Elementdatenliste et ; Typ des Elements ep ; Anfangspunkt, Mittelpunkt bzw. Kontrollpunkt des Elements er ; Endpunkt bzw. Richtungsvektor des Elements ez ; z-Koordinate des ersten Kontrollpunkts im aktuellen BKS e0 ; Datengruppe aus ed e1 ; Datengruppe aus ed dm ; Flag: Elementdaten wurden modifiziert kn ; Schlüsselnummer der aktuell bearbeiteten Datengruppe ld ; Datenliste des aktuell überprüften Layers ll ; Liste aller gesperrten Layer der Zeichnung tt ; temporäres Testflag ger ; Flag: deutsche Version tol ; Toleranz echo ; Systemvariable "cmdecho" [command echo] errr ; systemeigene Fehlerbearbeitungs-Routine ) (standardInitiate) (ironSelect) (ironInput) (lockedFilter) (ironProcess) (standardTerminate) ) (defun c:iron ( / s ; selection set zz ; desired Z coordinate in current UCS s# ; number of objects selected [on unlocked layers] l# ; number of objects selected on locked layers m# ; number of objects modified during processing e# ; index of object currently worked on en ; entity name ed ; entity data list et ; type of entity ep ; start point, center, or vertex of entity er ; end point or direction vector of entity ez ; current UCS Z coordinate of first control point e0 ; data group from ed e1 ; data group from ed dm ; flag: entity data were modified kn ; key number of current data group ld ; data list of layer currently tested ll ; list of all locked layers of the drawing tt ; temporary test flag ger ; flag: German version tol ; tolerance echo ; "cmdecho" system variable [command echo] errr ; system's error handling routine ) (standardInitiate) (ironSelect) (ironInput) (lockedFilter) (ironProcess) (standardTerminate) ) ;;; Unterprogramme 1. Ordnung für BÜGELN ;;; 1st order subroutines for IRON (defun ironSelect ( ) ; 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 " - Punkte, Konstruktionslinien, Strahlen, Linien," " Kreise, Bögen, Ellipsen, 2d-Polylinien, Splines -" ) (strcat " - points, xlines, rays, lines," " circles, arcs, ellipses, 2D polylines, splines -" ) ) ) (setq s (ssget '( (-4 . "") (-4 . "and>") ; no polygon/polyface meshes (0 . "SPLINE") (-4 . "or>") (-4 . "=") (39 . 0.0) ; zero thickness ) ; Filtering by extrusion direction is not possible yet ) ; because relational tests concerning group 210 ) ; do not allow a tolerance ["=" or "/=" only]. (if s (setq s# (sslength s) tt nil ) (princ (if ger "\nEs wurde keine gültige Auswahl getroffen." "\nNo valid selection made." ) ) ) ) ) (defun ironInput ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger ; set: zz (initget 129) ; arbitrary input (setq ; null input [just "Enter"] returns null string [""] zz (getpoint (if ger (strcat "Punkt mit gewünschter z-Koordinate " "im aktuellen BKS angeben " "oder Zahlenwert eingeben <0>: " ) (strcat "Specify a point " "whose Z coordinate becomes definitive " "or enter desired Z coordinate in current UCS <0>: " ) ) ) zz (if (= 'str (type zz)) (atof zz) (caddr zz)) ) ; (atof "") returns 0.0 ) (defun ironProcess ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: s s# ger tol ; set: m# e# en ed et e0 e1 ep er (if s (progn (princ "\n") (setq m# 0 e# 0 ) (while (> s# e#) (setq en (ssname s e#) ed (entget en) et (cdr (assoc 0 ed)) ) (cond ( (= "POINT" et) (ironProcessPoint) ) ( (or (= "XLINE" et) (= "RAY" et)) ; change only if direction vector is ; not perpendicular to current UCS XY plane (setq e1 (assoc 11 ed) er (trans (cdr e1) 0 1 t) ) (if (not (and (equal 0.0 (car er) tol) (equal 0.0 (cadr er) tol) ) ) (ironProcessXline|ray) ) ) ( (= "LINE" et) ; change only if line is ; not perpendicular to current UCS XY plane (setq e0 (assoc 10 ed) e1 (assoc 11 ed) ep (trans (cdr e0) 0 1) er (trans (cdr e1) 0 1) ) (if (not (and (equal (car ep) (car er) tol) (equal (cadr ep) (cadr er) tol) ) ) (ironProcessLine) ) ) ( (or (= "CIRCLE" et) (= "ARC" et) (= "ELLIPSE" et)) ; change only if parallel to current UCS XY plane (setq er (trans (cdr (assoc 210 ed)) 0 1 t)) (if (and (equal 0.0 (car er) tol) (equal 0.0 (cadr er) tol) ) (ironProcessCircle|arc|ellipse) ) ) ( (= "LWPOLYLINE" et) ; change only if parallel to current UCS XY plane (setq er (trans (cdr (assoc 210 ed)) 0 1 t)) (if (and (equal 0.0 (car er) tol) (equal 0.0 (cadr er) tol) ) (ironProcessLwpolyline) ) ) ( (= "POLYLINE" et) ; [Regarding 2D polylines, AutoCAD R14 and 2000 ; use this format for curve fit polylines only.] ; change only if parallel to current UCS XY plane (setq er (trans (cdr (assoc 210 ed)) 0 1 t)) (if (and (equal 0.0 (car er) tol) (equal 0.0 (cadr er) tol) ) (ironProcessPolyline) ) ) ( (= "SPLINE" et) (if (zerop (logand 8 (cdr (assoc 70 ed)))) (ironProcess3Dspline) (ironProcess2Dspline) ) ) ) (princ (if ger (strcat "\015" (itoa m#) (if (= 1 m#) " Objekt" " Objekte") " verändert. " ) (strcat "\015" (itoa m#) (if (= 1 m#) " object" " objects") " modified. " ) ) ) (setq e# (1+ e#)) ) ) ) ) ;;; Unterprogramme 2. Ordnung für ironProcess ;;; 2nd order subroutines for ironProcess (defun ironProcessPoint ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz ed tol ; set: e0 ep m# (setq ep (trans (cdr (setq e0 (assoc 10 ed))) 0 1)) (if (not (equal zz (caddr ep) tol)) (progn (entmod ; move point if required (subst (cons 10 (trans (list (car ep) (cadr ep) zz) 1 0)) e0 ed ) ) (setq m# (1+ m#)) ) ) ) (defun ironProcessXline|ray ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz er tol ; set: ed e0 e1 ep dm m# (if (not (equal 0.0 (caddr er) tol)) (setq ed ; project direction vector into XY plane (subst ; if required (cons 11 (trans (list (car er) (cadr er) 0.0) 1 0 t)) e1 ed ) dm t ) ) (setq ep (trans (cdr (setq e0 (assoc 10 ed))) 0 1)) (if (not (equal zz (caddr ep) tol)) (setq ed (subst ; move start point or "center" if required (cons 10 (trans (list (car ep) (cadr ep) zz) 1 0)) e0 ed ) dm t ) ) (if dm (progn (entmod ed) (setq m# (1+ m#) dm nil))) ) (defun ironProcessLine ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz ed e0 e1 ep er tol ; set: ed dm m# (if (not (equal zz (caddr ep) tol)) (setq ed (subst ; modify start point if required (cons 10 (trans (list (car ep) (cadr ep) zz) 1 0)) e0 ed ) dm t ) ) (if (not (equal zz (caddr er) tol)) (setq ed (subst ; modify end point if required (cons 11 (trans (list (car er) (cadr er) zz) 1 0)) e1 ed ) dm t ) ) (if dm (progn (entmod ed) (setq m# (1+ m#) dm nil))) ) (defun ironProcessCircle|arc|ellipse ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz en ed tol ; set: e0 ep m# ; translate center point from OCS to UCS (setq ep (trans (cdr (setq e0 (assoc 10 ed))) en 1)) (if (not (equal zz (caddr ep) tol)) (progn (entmod (subst ; move center if required (cons 10 (trans (list (car ep) (cadr ep) zz) 1 en)) e0 ed ) ) (setq m# (1+ m#)) ) ) ) (defun ironProcessLwpolyline ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz ed tol ; set: e0 e1 m# (setq e0 (assoc 38 ed) ; elevation of object plane above WCS origin e1 (- zz (caddr (trans '(0.0 0.0 0.0) 0 1))) ) (if (not (equal e1 (cdr e0) tol)) (progn ; modify if required (entmod (subst (cons 38 e1) e0 ed)) (setq m# (1+ m#)) ) ) ) (defun ironProcessPolyline ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz ed tol ; set: e0 e1 m# (setq e0 (assoc 10 ed) ; "dummy" point containing elevation e1 (- zz (caddr (trans '(0.0 0.0 0.0) 0 1))) ) (if (not (equal e1 (cadddr e0) tol)) (progn ; modify if required (entmod (subst (list 10 0.0 0.0 e1) e0 ed)) (setq m# (1+ m#)) ) ) ) (defun ironProcess3Dspline ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz tol ; set: ed e0 e1 ep er dm m# (foreach kn '(10 11) ; Scan control points / fit points ... (while (setq e0 (assoc kn ed)) (setq ep (trans (cdr e0) 0 1)) (if (equal zz (caddr ep) tol) (setq ; ... mask gradually ... ed (subst (cons "m" (cdr e0)) e0 ed) ) (setq ; ... and replace if required; ... ed (subst (cons "m" (trans (list (car ep) (cadr ep) zz) 1 0)) e0 ed ) dm t ) ) ) (while (setq e0 (assoc "m" ed)) (setq ed (subst (cons kn (cdr e0)) e0 ed)) ) ; ... remove masks. ) ; In case of multiple existence of a point in the data list, ; a single call of the "subst" function will replace ; several data groups. ; This is why the number of loop runs should not be controlled by ; groups 73 and 74 ; (number of control points and fit points of the spline). (foreach kn '(12 13) ; Scan start / end tangent vector ... (setq e1 (assoc kn ed)) (if e1 (progn (setq er (trans (cdr e1) 0 1 t)) (if (not (equal 0.0 (caddr er) tol)) (setq ed (if ; ... if perpendicular to XY plane ... (and (equal 0.0 (car er) tol) (equal 0.0 (cadr er) tol) ) (append ; ... then remove ... (reverse (cdr (member e1 (reverse ed)))) (cdr (member e1 ed)) ) (subst ; ... else replace. (cons kn (trans (list (car er) (cadr er) 0.0) 1 0 t ) ) e1 ed ) ) dm t ) ) ) ) ) (if dm (progn (entmod ed) (setq m# (1+ m#) dm nil))) ) (defun ironProcess2Dspline ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: zz ed tol ; set: kn ed e0 ep ez dm m# tt (setq kn 10 ; scan control points first e0 (assoc kn ed) ep (trans (cdr e0) 0 1) ez (caddr ep) tt t ) (while tt (if (if dm (not (equal ez (caddr ep) tol)) (equal zz ez tol)) (setq dm nil ; spline is not parallel to XY plane or tt nil ; its elevation is correct already, so don't change ) ; Test of extrusion direction [similar to polylines / circles] ; may deliver wrong results in case of linear splines; ; that's why a more difficult method is necessary. (progn (setq ed (subst ; modify and mask gradually (cons "m" (trans (list (car ep) (cadr ep) zz) 1 0)) e0 ed ) dm t e0 (assoc kn ed) ) (if e0 (setq ep (trans (cdr e0) 0 1)) (progn (while (setq e0 (assoc "m" ed)) (setq ed (subst (cons kn (cdr e0)) e0 ed)) ) ; remove masks (if (= 10 kn) (progn (setq ; after control points kn 11 ; scan fit points e0 (assoc kn ed) ) (if e0 (setq ep (trans (cdr e0) 0 1)) (setq tt nil) ; there are no fit points ) ) (setq tt nil) ; all points were scanned ) ) ) ) ) ) (if dm (progn (entmod ed) (setq m# (1+ m#) dm nil))) ) ;______________________________________________________________________; ;;; Unterprogramm zum Ausfiltern von Objekten auf gesperrten Layern ;;; ;;; Die Objektwahl und die Wahl möglichst aller benötigten Optionen ;;; müssen dem Aufruf dieses Unterprogramms vorausgehen; außerdem ;;; muss s# bereits auf die Anzahl der Objekte im vorherigen ;;; Auswahlsatz gesetzt worden sein. ;;; "lockedFilter" sollte erst dann ausgeführt werden, wenn ;;; der Befehl "'layer" nicht mehr transparent aufgerufen werden kann. ;;; Subroutine for filtering out objects on locked layers ;;; ;;; Object selection must precede this subroutine. ;;; s# has to be set on the number of objects in previous ;;; selection set before running this subroutine. ;;; "lockedFilter" should not be called until ;;; the "'layer" command cannot be started transparently any more. (defun lockedFilter ( ) ; The following variables declared in the main routines ; are used within this subroutine: ; get: ger ; set: s s# l# ld ll (setq ld (tblnext "layer" t)) (if (= 4 (logand 4 (cdr (assoc 70 ld)))) (setq ll (list (cons 8 (cdr (assoc 2 ld))))) ) (while (setq ld (tblnext "layer")) (if (= 4 (logand 4 (cdr (assoc 70 ld)))) (setq ll (cons (cons 8 (cdr (assoc 2 ld))) ll)) ) ) (if ll (setq ll (append '((-4 . "") (-4 . "not>")) ) ) ) (setq s (ssget "_p" ll)) (if s (progn (setq l# s# s# (sslength s) l# (- l# s#) ) (cond ( (= 1 l#) (princ (if ger (strcat "\n" "Eines der gewählten Objekte " "liegt auf einem gesperrten Layer." ) (strcat "\n" "One of the selected objects " "lies on a locked layer." ) ) ) ) ( (< 1 l#) (princ (if ger (strcat "\n" (itoa l#) " der gewählten Objekte" " liegen auf gesperrten Layern." ) (strcat "\n" (itoa l#) " of the selected objects lie on locked layers." ) ) ) ) ) ) (progn (if (= 1 s#) (princ (if ger (strcat "\n" "Das gewählte Objekt " "liegt auf einem gesperrten Layer." ) (strcat "\n" "The selected object lies on a locked layer." ) ) ) (princ (if ger (strcat "\n" "Alle gewählten Objekte " "liegen auf gesperrten Layern." ) (strcat "\n" "All selected objects lie on locked layers." ) ) ) ) ) ) ) ;______________________________________________________________________; ;;; 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) ) ;______________________________________________________________________; (princ (if (wcmatch (ver) "*(de)") "\n BÜGELN © Armin Antkowiak Oktober 2000" "\n IRON © Armin Antkowiak October 2000" ) ) (princ)