m.stangl/Walz
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

neue Folder LAYOUT MENU und MODULE dazu

Browse Source
This commit is contained in:
Michael Stangl
2025-04-14 16:56:58 +02:00
parent e6e1705f0d
commit 35f7b2d75e
935 changed files with 803964 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
MENU/XPLODE.LSP
+538
View File
@@ -0,0 +1,538 @@
;;;---------------------------------------------------------------------------;
;;;
;;; XPLODE.LSP
;;; Copyright (C) 1990 by Autodesk, Inc.
;;;
;;; Jan S. Yoder & K.C. Jones Version 1.0
;;;
;;; --------------------------------------------------------------------------;
;;; šBERSICHT
;;;
;;;
;;; Dieses Programm ersetzt den URSPRUNG Befehl in AutoCAD. Hiermit k”nnen
;;; alle Attribute einzelner Objekte eines Blocks oder einer Gruppe von
;;; Bl”cken bei der Zerlegung in die Einzelteile kontrolliert werden. Es gibt
;;; einige wesentliche Unterschiede zwischen XPLODE und dem URSPRUNG-Befehl
;;; in AutoCAD.
;;;
;;; Zum ersten k”nnen unbegrenzt viele Objekte selektiert werden. Alle
;;; Bemaáungen, PolyLinien und PolyNetze sowie Blockeinf�gepunkte werden
;;; aus der ausgew„hlten Gruppe selektiert und k”nnen mit dem XPlode-Befehl
;;; global oder individuell angesprochen werden. Wird URSPRUNG global
;;; gew„hlt, erscheint f�r alle betreffenden Objekte die Abfrage:
;;;
;;; All/Color/LAyer/LType/Inherit from parent block/<Explode>:
;;;
;;; Sollen die einzelnen Objekte individuell bearbeitet werden, muá f�r jedes
;;; einzelne Objekt eine Option aus dieser Auswahlzeile gew„hlt werden.
;;;
;;; Zum zweiten ist es mit dem URSPRUNG Befehl in AutoCAD nicht m”glich,
;;; bei der Zerlegung eines Blocks die Attribute der einzelnen Objekte zu
;;; ver„ndern. Ebenso ist es nicht m”glich, die Attribute einzelner Objekte
;;; des urspr�nglichen Block zu �bernehmen.
;;;
;;;
;;; ALL
;;;
;;; Hiermit k”nnen Farbe, Linientyp und Layer f�r neue Objekte festgelegt
;;; werden.
;;;
;;; COLOR
;;;
;;; Bei Anwahl dieser Option kann f�r die einzelnen Objekte eine neue Farbe
;;; ausgew„hlt werden:
;;;
;;; Neue Farbe f�r zerlegte Objekte
;;; Red/Yellow/Green/Cyan/Blue/Magenta/White/BYLayer/BYBlock/<cecolor>:
;;;
;;; Es kann jede Farbnummer zwischen 1 und 255 oder eine der angegebenen
;;; Standardfarben ausgew„hlt werden. "Cecolor" ist die aktuelle Farbe des
;;; Objekts, die von der Systemvariablen CECOLOR zugeordnet wird.
;;;
;;; LAYER
;;;
;;; Mit der Option LAYER kann der Name des Layers bestimmt werden, auf dem
;;; die einzelnen Objekte plaziert werden sollen:
;;;
;;; XPlode onto what layer? <clayer>:
;;;
;;; Der Name des Layers wird abgepr�ft, existiert er nicht, wird die Abfrage
;;; wiederholt. RETURN ohne weitere Eingabe w„hlt den aktuellen Layer aus.
;;;
;;; LTYPE
;;;
;;; LTYPE gibt eine Liste der geladenen Linientypen der aktuellen Zeichnung
;;; aus und erwartet die Auswahl eines Linientyps. Hier muá (leider) die
;;; volle Bezeichnung des Linientyps eingegeben werden, es sei denn, der
;;; aktuelle Linientyp wird mit RETURN akzeptiert.
;;;
;;; Choose from the following list of linetypes.
;;; CONTinuous/...others.../<CONTINUOUS>:
;;;
;;; INHERIT
;;;
;;; šbernahme bedeutet in Bezug auf den urspr�nglingen Block, daá die
;;; Attribute des zu zerlegenden Blocks ohne weitere Auswahloption auf die
;;; einzelnen Objekte des Blocks �bertragen werden.
;;;
;;; URSPRUNG
;;;
;;; Diese Option l”st den URSPRUNG Befehl mit den aktuellen Einstellungen
;;; f�r alle momentan ausgew„hlten Objekte aus
;;;
;;; --------------------------------------------------------------------------;
;;; ------------------------ INTERNES FEHLERVERHALTEN ------------------------;
(defun xp_err (s) ; Ereignet sich ein Fehler (z.B. CTRL-C)
; bei der Ausf�hrung dieses Befehls...
(if (/= s "Funktion abgebrochen")
(princ (strcat "\nFehler: " s))
)
(if xp_oce (setvar "cmdecho" xp_oce)) ; urspr�nglichen cmdecho-Wert einsetzen
(setq *error* olderr) ; urspr�ngliche Fehlerroutine einsetzen
(princ)
)
;;; ---------------------------- ALLGEMEINE FUNKTION -------------------------;
(defun xp_val (n e f)
(if f ; falls f zutrifft, stellt e eine Objektliste dar.
(cdr (assoc n e))
(cdr (assoc n (entget e)))
)
)
;;; ------------------- OBJEKT FšR URSPRUNG BEREITSTELLEN --------------------;
;;; ---------------------------- HAUPTPROGRAMM -------------------------------;
(defun explode ( / oce ohl e0 en e1 s0)
;; Versionsnummer. Bei Ab„nderung bitte lokal zur�cksetzen.
(setq xp_ver "0.10")
;;(setq xp_oer *error*
;; *error* xp_err)
(setq xp_oce (getvar "cmdecho")) ; cmdecho-Wert sichern
(setvar "cmdecho" 0) ; cmdecho abschalten
(graphscr)
(princ (strcat "\nXPlode, Version " xp_ver ", (c) 1990 by Autodesk, Inc. "))
(princ "\nObjekte w„hlen, die XPloded werden sollen. ")
(setq ss (ssget))
(if ss
(progn
;; Aussortieren von Objekten die nicht in URSPRUNG einbezogen werden...
(setq ss (xp_sxe)) ; DLine_Sort_Xplodable_Entities
;; XPlode Individuell oder Global.
(if (> (sslength ss) 0)
(progn
(if (> (sslength ss) 1)
(progn
(initget "Individuell Global")
(setq ans (getkword "\n\nXPlode Individuell/<Global>: "))
)
(setq ans "Global")
)
(cond
((= ans "Individuell")
(setq sslen (sslength ss)
j 0
)
(while (< j sslen)
(setq temp (ssname ss j)
prmpt T
)
(redraw temp 3)
(setq typ (xp_gxt))
(xp_xpe temp typ)
(redraw temp 4)
(setq j (1+ j))
)
)
(T
(setq sslen (sslength ss)
j 0
ans "Global"
prmpt T
)
(setq typ (xp_gxt))
(while (< j sslen)
(setq temp (ssname ss j))
(xp_xpe temp typ)
(setq j (1+ j))
)
)
)
)
)
)
)
(if xp_oce (setvar "cmdecho" xp_oce)) ; urspr�nglichen cmdecho-Wert einsetzen
(setq *error* xp_err) ; urspr�ngliche Fehlerroutine einsetzen
(prin1)
)
;;;
;;; Alle Objekte aussortieren, die in die Zerlegung mit einbezogen werden
;;; sollen. Bitte beachten, daá bei Einf�gen von Bl”cken die X-, Y- und
;;; Z-GrӇenfaktoren gleich sind.
;;;
;;; xp_sxe == DLine_Sort_Xplodable_Entities
;;;
(defun xp_sxe (/ temp bad)
(setq sslen (sslength ss)
j 0
ss1 (ssadd)
)
(while (< j sslen)
(setq temp (ssname ss j))
(setq j (1+ j))
(if (member (xp_val 0 temp nil) '("INSERT" "DIMENSION" "POLYLINE"))
(if (= (xp_val 0 temp nil) "INSERT")
(if (and (= (xp_val 41 temp nil) (xp_val 42 temp nil))
(= (xp_val 41 temp nil) (xp_val 43 temp nil))
)
(ssadd temp ss1)
)
(ssadd temp ss1)
)
)
)
(setq sslen (sslength ss)
bad (sslength ss1)
)
(princ "\n")
(princ sslen)
(princ " Objekte gefunden. ")
(if (> (- sslen bad) 0)
(progn
(princ (- sslen bad))
(princ " ung�ltig. ")
)
)
ss1
)
;;;
;;; Art der Zerlegung bestimmen.
;;;
;;; xp_gxt == XPlode_Get_Xplode_Type
;;;
(defun xp_gxt (/ temp)
(initget "Alles Farbe LAyer LType šbernehmen Zerlegen")
(setq temp (getkword
"\n\nAlles/Farbe/LAyer/LType/šbernehmen vom �berg. Block/<Zerlegen>: "))
(if (or (= temp "") (null temp))
(setq temp "Zerlegen")
)
temp
)
;;;
;;; Ein Objekt in seine Einzelteile zerlegen.
;;;
;;; xp_xpe == XPlode_XPlode_Entity
;;;
(defun xp_xpe (ent typ / )
(cond
((= typ "Alles")
(if prmpt
(progn
(setq color (xp_scn))
(setq ltype (xp_slt))
(setq layer (xp_sla))
(setq prmpt nil)
)
)
(xp_xfa)
(if (or (= ans "Individuell") (= j (1- sslen)))
(progn
(if (and (> sslen 1) (= ans "Global"))
(princ "\nObjekte ")
(princ "\nObjekt ")
)
(princ (strcat "zerlegt my Farbe von "
(if (= (type color) 'INT) (itoa color) color) ", "
"Linietyp von " ltype ", "
"und Layer " layer "."))
)
)
)
((= typ "Farbe")
(if prmpt
(progn
(setq color (xp_scn))
(setq ltype (getvar "celtype"))
(setq layer (getvar "clayer"))
(setq prmpt nil)
)
)
(xp_xfa)
(if (or (= ans "Individuell") (= j (1- sslen)))
(progn
(if (and (> sslen 1) (= ans "Global"))
(princ "\nObjekte ")
(princ "\nObjekt ")
)
(princ (strcat "zerlegt mit Farbe von "
(if (= (type color) 'INT) (itoa color) color) "."))
)
)
)
((=
typ "LAyer")
(if prmpt
(progn
(setq color (getvar "cecolor"))
(setq ltype (getvar "celtype"))
(setq layer (xp_sla))
(setq prmpt nil)
)
)
(xp_xfa)
(if (or (= ans "Individuell") (= j (1- sslen)))
(progn
(if (and (> sslen 1) (= ans "Global"))
(princ "\nObjekte ")
(princ "\nObjekt ")
)
(princ (strcat "zerlegt auf Layer " layer "."))
)
)
)
((= typ "LType")
(if prmpt
(progn
(setq color (getvar "cecolor"))
(setq ltype (xp_slt))
(setq layer (getvar "clayer"))
(setq prmpt nil)
)
)
(xp_xfa)
(if (or (= ans "Individuell") (= j (1- sslen)))
(progn
(if (and (> sslen 1) (= ans "Global"))
(princ "\nObjekte ")
(princ "\nObjekt ")
)
(princ (strcat "zerlegt mit Linientyp von " ltype "."))
)
)
)
((= typ "šbernehmen")
(xp_iap ent)
)
(T
(command "ursprung" (xp_val -1 ent nil))
)
)
)
;;;
;;; Farb-, Linientyp- und Layerattribute nach dem Zerlegen festlegen.
;;;
;;; xp_xea == XPlode_Xplode_Force_All
;;;
(defun xp_xfa ()
(setq e0 (entlast))
(setq en (entnext e0))
(while (not (null en)) ; Letztes Objekt ermitteln
(setq e0 en)
(setq en (entnext e0))
)
(command "ursprung" (xp_val -1 ent nil)) ; Objekt in Einzelteile zerlegen
(setq s0 (ssadd))
(while (entnext e0)
(ssadd (setq e0 (entnext e0))
s0
)
)
(command "eig„ndr" s0 "" ; Objekte mit gew�nschter Layerfarbe und
"f" color ; Linientyp versehen ohne Beachtung ihrer
"lt" ltype ; ihrer Ausdehnungsrichtung.
"la" layer
""
)
)
;;;
;;; Attribute von urspr�nglichem Block �bernehmen (falls VONBLOCK)
;;;
;;; xp_iap == XPlode_Inherit_Attributes_from_Parent
;;;
(defun xp_iap (t1 / t1cl t1lt t1ly s0ly s0lt s0cl t0e)
(setq t0 (entlast))
(setq tn (entnext t0))
(while (not (null tn)) ; Letztes Objekt suchen
(setq t0 tn)
(setq tn (entnext t0))
)
(setq t1cl (xp_val 62 t1 nil)) ; Blockattribute protokollieren
(setq t1lt (xp_val 6 t1 nil))
(setq t1ly (xp_val 8 t1 nil))
(command "ursprung" (xp_val -1 t1 nil)) ; Objekt in Einzelteile zerlegen
(setq s0ly (ssadd)) ; Blanko-Auswahlsatz f�r Layer einrichten
(setq s0lt (ssadd)) ; Žnderung von Linientyp und Farbe
(setq s0cl (ssadd))
(setq t0 (entnext t0))
(while t0 ; Zerlegte Objekte sichern
(setq t0e (entget t0)) ; und Auswahls„tze einrichten
(if (= (xp_val 62 t0e T) "VONBLOCK") (ssadd t0 s0cl))
(if (= (xp_val 6 t0e T) "VONBLOCK") (ssadd t0 s0lt))
(if (= (xp_val 8 t0e T) "0") (ssadd t0 s0ly))
(setq t0 (entnext t0))
)
(if (> (sslength s0cl) 0) ; falls Auswahlsatz kein Blanko...
(command "eig„ndr" s0cl "" ; Farbe der zerlegten Objekte (festgelegt
"f" t1cl "") ; durch VONBLOCK) in Farbe des urspr�ng-
; lichen Blocks um„ndern
)
(if (> (sslength s0lt) 0)
(command "eig„ndr" s0lt "" ; Linientyp der zerlegten Objekte (festge-
"lt" t1lt "") ; legt durch VONBLOCK) in Linientyp des
; urspr�nglichen Blocks um„ndern
)
(if (> (sslength s0ly) 0)
(command "eigndr" s0ly "" ; Linientyp der zerlegten Objekte (festge-
"la" t1ly "") ; legt durch VONBLOCK) in Linientyp des
; urspr�nglichen Blocks um„ndern.
)
(if (or (= ans "Individuell") (= j (1- sslen)))
(progn
(if (and (> sslen 1) (= ans "Global"))
(princ "\nObjekte ")
(princ "\nObjekt ")
)
(princ "zerlegt.")
)
)
)
;;;
;;; Farbe der in Einzelteile zerlegten Objekte bestimmen.
;;;
;;; xp_scn == XPlode_Set_Color_Number
;;;
(defun xp_scn ()
(setq arg 257)
(while (> arg 256)
(initget 2 "Rot GElb GR�n Cyan Blau Magenta Weiá VONLayer VONBlock")
(setq arg (getint (strcat
"\n\nNeue Farbe f�r zerlegte Objekte. "
"\nRot/GElb/GR�n/Cyan/Blau/"
"Magenta/Weiá/VONLayer/VONBlock/<"
(if (= (type (getvar "cecolor")) 'INT)
(itoa (getvar "cecolor"))
(getvar "cecolor")
)
">: ")))
(cond
((= arg "VONLayer") (setq arg 0))
((= arg "Rot") (setq arg 1))
((= arg "GElb") (setq arg 2))
((= arg "GR�n") (setq arg 3))
((= arg "Cyan") (setq arg 4))
((= arg "Blau") (setq arg 5))
((= arg "Magenta") (setq arg 6))
((= arg "Weiá") (setq arg 7))
((= arg "VONBlock") (setq arg 256))
(T
(if (= (type arg) 'INT)
(if (> arg 255)
(progn
(princ "\nFarbnummer muá zwischen 1 und 255 liegen. ")
(setq arg 257) ; kludge
)
)
(setq arg (if (= (type (setq arg (getvar "cecolor"))) 'INT)
(getvar "cecolor")
(cond
((= arg "VONLAYER") (setq arg 0))
((= arg "VONBLOCK") (setq arg 256))
)
)
)
)
)
)
)
(cond
((= arg 0) (setq arg "VONBLOCK"))
((= arg 256) (setq arg "VONLAYER"))
)
arg
)
;;;
;;; Einen Linientyp aus den geladenen Linientypen ausw„hlen.
;;;
;;; xp_slt == XPlode_Set_Line_Type
;;;
(defun xp_slt ()
(princ "\n\nW„hlen Sie aus der folgenden Linientypliste. ")
(tblnext "ltype" T)
(setq xp_lta "CONTINUOUS,CONT VONLayer VONBlock"
xp_ltb "VONBlock/VONLayer/CONTinuous")
(while (setq xp_lt (cdr(assoc 2 (tblnext "ltype"))))
(setq xp_lta (strcat xp_lta " " xp_lt)
xp_ltb (strcat xp_ltb "/" xp_lt))
)
(initget xp_lta)
(princ (strcat
"\nNeuer Linientypname. \n" xp_ltb "/<"
(getvar "celtype") "> : "))
(setq xp_nln (getkword) )
(if (or (= xp_nln nil) (= xp_nln ""))
(setq xp_nln (getvar "celtype"))
)
xp_nln
)
;;;
;;; Einen Layer angeben - falls einer vorhanden.
;;;
;;; xp_sla == XPlode_Set_LAyer
;;;
(defun xp_sla (/ temp)
(while (null temp)
(initget 1)
(setq temp (getstring (strcat
"\n\nAuf welchen Layer zerlegen ? <" (getvar "clayer") ">: ")))
(if (or (= temp "") (null temp))
(setq temp (getvar "clayer"))
(if (not (tblsearch "layer" temp))
(progn
(princ "\nUng�ltiger Layername. ")
(setq temp nil)
)
)
)
)
temp
)
;;; --------------------------------------------------------------------------;
(defun c:xp () (explode))
(defun c:xplode () (explode))
(princ
"\n\tC:XPLode geladen. Funktion mit XP oder XPLODE starten.")
(prin1)