;; --------------------------------------------------------------------------------------------------- ;;
;; -- Aufschreiber : Th.Krüger , Eberswalde      (Fragmentautoren ??? - Wenn ja, dann Danke )       -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
;; -- Datum : 05.02.04                                                                              -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
;; -- Freeware oder besser BTN-WARE ("Better than Nothing" ..damit das AutoCad besser werde )       -- ;;
;; -- Dabei Danke an alle , die nach dem gleichen Grundsatz Anregungen, Tipps und Lisp's zur        -- ;;
;; -- Verfügung stellen... und auf deren Grundlagen so manches meinerseits fußt...                  -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
;; -- Besonderer Dank an MAPCAR (http://www.autolisp.mapcar.net) für seinen Error-Handler           -- ;;
;; --------------------------------------------------------------------------------------------------- ;;


;; --------------------------------------------------------------------------------------------------- ;;
;; -- StartErrorHandler : Stapelbare Fehlerbehandlungsroutine                                       -- ;;
;; --                     NAME ist ein frei wählbarer String. Wenn eine (*error*)-Funktion etwas    -- ;;
;; --                     auf dem Bildschirm ausgibt, setzt sie diesen Namen dazu, damit man        -- ;;
;; --                     unterscheiden kann, was von welcher Instanz des Errhandlers kommt.        -- ;;
;; --                     UNDOMODE kann T oder nil sein und gibt an, ob im Fehler- bzw. Abbruchs-   -- ;;
;; --                     fall gleich der Befehl 'Z' ausgeführt werden soll, um alle bis dahin      -- ;;
;; --                     vorgenommen Aktionen sofort rückgängig zu machen.                         -- ;;
;; --                     VARS_TO_SAVE sind die zu setzenden Systemvariablen und Globalen Variablen -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
;; --  .. Aufruf:         (defun c:Test( / )                                                        -- ;;
;; --                        (startErrorHandler "Funktion TEST" 'T                                  -- ;;
;; --                                           '(("cmdecho"  0)("filedia"  0)("MYOWN" nil))        -- ;;
;; --                        )                                                                      -- ;;
;; --                        .......                                                                -- ;;
;; --                        (endErrorHandler)                                                      -- ;;
;; --                     )                                                                         -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun StartErrorHandler( NAME UNDOMODE VARS_TO_SAVE /
                          ErrorTemplate SAVELIST)  
  ;; --  Schablone für programmspezifische Fehlerroutine -- ;;
  (setq ErrorTemplate                                        
     '( (MSG / NAME UNDO SAVEDVARS PREVIOUSHANDLER ZAEHLER AUSWAHLSATZ)
         ;... Zeile wird eventuell noch eingesetzt..                                     Siehe unten ....
         (while(>(getvar "cmdactive")0)(command))       ; noch ein "ACAD-Befehl aktiv ??, dann Abbrechen!
    
         (command"_undo""_end")                                                      ; Undo-Endmarkierung
         (if (and undo msg) (command"_u"))              ; wenn Undo True, dann alle Aktionen zurücksetzen
         (foreach PAIR SAVEDVARS                                      ; Veränderte Variablen zurücksetzen
           (if (Getvar (car PAIR))                                         ; ist es eine Systemvariable ?
             (setvar(car PAIR)(cadr PAIR))                                 ; dann zurücksetzen mit SETVAR
             (set (read(car PAIR)) (cadr PAIR))                             ;..sonst mit SET zurücksetzen
           ) 
         )
                 
       
         (setq ZAEHLER 0)
         (setq AUSWAHLSATZ (ssget "X"))
         (while (and AUSWAHLSATZ (setq ELEMENT (ssname AUSWAHLSATZ ZAEHLER)))        
            (redraw ELEMENT 4)                                                   ; Ausleuchten abschalten
           (setq ZAEHLER (1+ ZAEHLER))
         )
      
         (setq *error* previousHandler)            ; Fehlerroutine auf ursprüngliche Fehlerroutine setzen
         (if msg
           (progn
             (princ(strcat"\n" Name ": \"" msg "\""))                        ; und Fehlermeldung ausgeben
             (if previousHandler(previousHandler msg))
           )
         )
       )
  )    


  ;; -- Systemvariablen behandeln -- ;

  (if (=(type VARS_TO_SAVE) 'LIST)    
    (foreach PAIR VARS_TO_SAVE  ; Liste mit den Systemvariablen und den zu setzenden  Werten durchlaufen 
      (if (=(type PAIR) 'LIST) 
	(if (=(length PAIR) 2) 
	  (if (=(type(car PAIR)) 'STR)

            (if (Getvar (car PAIR))                           ; konnte Systemvariable ausgelesen werden ?
              (progn
                (setq SAVELIST  (append SAVELIST; Namen der Systemvariable und alten Wert als "2er-Liste"
                                        (list (list (car PAIR) (getvar (car PAIR)))))    ; .. in SAVELIST
                )                                                                         ;  speichern ..
                (setvar(car PAIR)(cadr PAIR))         ; anschließend Systemvariable auf neuen Wert setzen
              )
              (progn
                (setq SAVELIST  (append SAVELIST      ; Namen der Variable und alten Wert als "2er-Liste"
                                        (list (list (car PAIR) (eval(read(car PAIR)))))) ; .. in SAVELIST
                )                                                                         ;  speichern ..
                (set (read(car PAIR)) (cadr PAIR))          ; anschließend Variable auf neuen Wert setzen
              )  
            )
          )
        )
      )
    )
  )  

  (command"_undo""_begin")                     ; Undo-Markierung für "Rückgängig ab diesem Punkt" setzen 

  ;; -- Error-Handler installieren -- ;; 
  (setq *error* 
    (append                                                            ; und ErrorTemplate initialisieren
      (list(car ErrorTemplate))                   ; erste Zeile (Unterliste von ErrorTemplate) hinzufügen
      (if undomode'((setq undo 'T)))                                   ; .. ergänzende Zeilen einfügen ..
      (list
        (list 'setq
          'PreviousHandler
          (cons'quote(list *error*))
        )
      )
      (list(list 'setq 'name name))
      (list
        (cons'setq
          (cons'savedvars
            (list(cons'quote(list savelist)))
          )
        )
      )
      (cdr ErrorTemplate)                                         ; Rest von ErroTemplate hinzufügen ....
    )                                                                                      ; end [APPEND]
  )                                                                                  ; end [SETQ *ERROR*]
)                                                                                           ; end [DEFUN]
;; --------------------------------------------------------------------------------------------------- ;;


;; --------------------------------------------------------------------------------------------------- ;;
;; -- EndErrorHandler : Beendet Nutzerspezifischer Error-Handling                                   -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun EndErrorHandler( / )
  (*error* nil)                                      ; alle Änderungen von StartErrorHandler restaurieren
)
;; --------------------------------------------------------------------------------------------------- ;;



;; aus BIBO-Objekts

;; --------------------------------------------------------------------------------------------------- ;;
;; -- OBJEKT_ALLGEMEIN_SET: Setzen der allgemeinen Objekteigenschaften. Dabei werden die Parameter  -- ;;
;; --                       wie folgt übergeben:
;; --                       FARBE   : Integerzahl von 0 bis 256 ; 0= "von Block" , 256= "von Layer" -- ;;
;; --                       LAYER   : String   ( wird notfalls angelegt )                           -- ;;
;; --                       LTYPE   : String   ( wird notfalls angelegt ) "ByLayer" "ByBlock"       -- ;;
;; --                       LTFAKTOR: Real oder Integerzahl                                         -- ;;
;; --                       LDICKE  : String mit Realzahl oder "Vorgabe","ByLayer","ByBlock"        -- ;;
;; --                       ISt eine Eigenschaft "nil" oder fehlerhaft, so wird sie nicht verändert.-- ;;
;; --                       z.B. (OBJEKT_ALLGEMEIN_SET (entlast) 256 nil "Continuous 1 "Vorgabe")   -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun OBJEKT_ALLGEMEIN_SET ( OBJEKT FARBE LAYER LTYPE LTFAKTOR LDICKE / OBJEKTDATEN)
  (if (=(type OBJEKT) 'ENAME)                                                          ; Parameter o.k. ?
    (progn
      (setq OBJEKTDATEN (entget OBJEKT))
              
      (if (=(type FARBE) 'INT)                                                              ; Objektfarbe
        (if (and (>= FARBE 0)(<= FARBE 256))       
          (if(assoc 62 OBJEKTDATEN)                                                           
            (setq OBJEKTDATEN(subst(cons 62 FARBE)(assoc 62 OBJEKTDATEN)OBJEKTDATEN))         
            (setq OBJEKTDATEN  ( append Objektdaten (list(cons 62 FARBE))))
          )
        )  
      )  
   
      (if (=(type LAYER) 'STR)                                                              ; Objektlayer
        (progn
          ;; (if (not(GET_LAYER LAYER)) (MAKE_LAYER LAYER nil 'T))
          (if (assoc 8 OBJEKTDATEN)
            (setq OBJEKTDATEN(subst(cons 8 LAYER)(assoc 8 OBJEKTDATEN)OBJEKTDATEN))        
          )
        )  
      )  

      (if (=(type LTYPE) 'STR)                                                         ; Objektlinientyp
        (progn
          ;; (if (not(GET_LINETYP LTYPE)) (MAKE_DUMMYLINE LTYPE))
          (if (assoc 6 OBJEKTDATEN)
            (setq OBJEKTDATEN(subst(cons 6 LTYPE)(assoc 6 OBJEKTDATEN)OBJEKTDATEN))
            (setq OBJEKTDATEN  ( append Objektdaten (list(cons 6 LTYPE))))
          )
        )  
      )

      (if (or(=(type LTFAKTOR) 'REAL)  (=(type LTFAKTOR) 'INT))                   ; ObjektLinientypfaktor
        (if (assoc 48 OBJEKTDATEN)
          (setq OBJEKTDATEN(subst(cons 48 (* LTFAKTOR 1.0))(assoc 48 OBJEKTDATEN)OBJEKTDATEN))
          (setq OBJEKTDATEN  ( append Objektdaten (list(cons 48 (* LTFAKTOR 1.0)))))
        )
      )
      
      (if (=(type LDICKE) 'STR)                                                      ; ObjektLinienstärke
        (cond                                                                        
          ( (= (strcase LDICKE) "BYLAYER")
            (if (assoc 370 OBJEKTDATEN)
              (setq OBJEKTDATEN(subst(cons 370 -1)(assoc 370 OBJEKTDATEN)OBJEKTDATEN))
              (setq OBJEKTDATEN  ( append Objektdaten (list(cons 370 -1))))
            )         
          )
          ( (= (strcase LDICKE) "BYBLOCK") 
            (if (assoc 370 OBJEKTDATEN)
              (setq OBJEKTDATEN(subst(cons 370 -2)(assoc 370 OBJEKTDATEN)OBJEKTDATEN))
              (setq OBJEKTDATEN  ( append Objektdaten (list(cons 370 -2))))
            )                  
          )
          ( (= (strcase LDICKE) "VORGABE") 
            (if (assoc 370 OBJEKTDATEN)
              (setq OBJEKTDATEN(subst(cons 370 -3)(assoc 370 OBJEKTDATEN)OBJEKTDATEN))
              (setq OBJEKTDATEN  ( append Objektdaten (list(cons 370 -3))))
            )         
          )        
          ('T            
            (setq LDICKE (atoi(rtos(*(atof LDICKE)100) 2 2)))
            (if (or(< LDICKE 0)(> LDICKE 211)) (setq LDICKE -3))
            (if (assoc 370 OBJEKTDATEN)
              (setq OBJEKTDATEN(subst(cons 370 LDICKE)(assoc 370 OBJEKTDATEN)OBJEKTDATEN))
              (setq OBJEKTDATEN  ( append Objektdaten (list(cons 370 LDICKE))))
            )
  
          ) 
        )
      )
      
      (entmod OBJEKTDATEN)                         ; Objektdaten in der Zeichnungsdatenbank aktualisieren
    )
  )  
)
;; --------------------------------------------------------------------------------------------------- ;;





;; aus BIBO-SCAN

;; --------------------------------------------------------------------------------------------------- ;;
;; -- SPIN : Funktion zur Spinradausgabe in der Kommandozeile (Kleiner Gimmick)                     -- ;;
;; --        Aufruf (setq SPINSYM (Spin SPINSYM))  mit SPINSYM als übergeordneter Variable          -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun Spin (SYM / )
  (setq SYM   (cond ((= SYM "-" ) "\\")
                    ((= SYM "\\") "|" )
                    ((= SYM "|" ) "/" )
                    ((= SYM "/" ) "-" )
                    (T            "-" )))
  (princ (strcat "\rScanning... " SYM "  "))
  SYM
)
;; --------------------------------------------------------------------------------------------------- ;;
  


;; --------------------------------------------------------------------------------------------------- ;;
;; -- UPDATE_BLOCK : Ändert den ersten Block der übergebenen Blockliste entsprechend den Vorgaben   -- ;;
;; --                und liefert evtl. um im Block gefundenen Inserts modifizierte RestBlockliste   -- ;;
;; --                zurück                                                                         -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun UPDATE_BLOCK( BLOCKLISTE / BLOCKDEF BLOCKNAME BLOCKELEMENT SPINSYM )  
  ;;(if (and(=(type BLOCKLISTE) 'LIST)(=(type UPDATE_OBJEKT)'SUBR)); Parameter o.k. und Funktion definiert?
  (if (=(type BLOCKLISTE) 'LIST)                                  ; Parameter o.k. und Funktion definiert?
    (progn      
      (setq BLOCKNAME (cdr (assoc 0 BLOCKLISTE)))               ; Aktuell zu bearbeiteden Block holen und
      (setq BLOCKLISTE(subst (cons 1 BLOCKNAME) (assoc 0 BLOCKLISTE) BLOCKLISTE)); ..Block als bearbeitet
                                                                                              ; markieren

      (if(setq BLOCKDEF (tblsearch "BLOCK" BLOCKNAME))          ; Blockdefinition zum Blocknamen auslesen
	(progn          	  
          (if (and (/=(logand(cdr(assoc 70 BLOCKDEF))4)4)                 ; ist Block kein kein XREF, und
                   (or (/= (logand(cdr(assoc 70 BLOCKDEF))1)1)          ; auch kein unbenannter Block wie
                       (=(vl-string-search "*U" BLOCKNAME) 0))           ; Bemassung , Schraffur ect. ...
              )     
            (progn
              (setq BLOCKELEMENT (cdr (assoc -2 BLOCKDEF)))             ; Adresse der Blockelemente holen
              (while BLOCKELEMENT            ; und solange nicht alle Blockelemente abgearbeitet sind ...
                (if (=(cdr(assoc 0 (entget BLOCKELEMENT))) "INSERT"); Ist BLOCKELEMENT ein Block, dann...
                  (progn                   
                    (setq BLOCKNAME(cdr(assoc 2(entget BLOCKELEMENT))))  ;BLOCKNAME des Unterblocks holen
                    
                    (if (or (not(member (cons 0 BLOCKNAME) BLOCKLISTE)) ; wenn Blockname  nicht in Liste,
                            (not(member (cons 1 BLOCKNAME) BLOCKLISTE))); .. dann als unbearbeitet (0) in
                      (setq BLOCKLISTE (append BLOCKLISTE (list (cons 0 BLOCKNAME))))  ; .. Liste ablegen
                    )
                  )                                                      
                )
                
                (UPDATE_OBJEKT BLOCKELEMENT )            ; ==> Objektbearbeitungsfunktion aufrufen

                (setq SPINSYM (SPIN SPINSYM))     ; und in der Befehlszeile anzeigen, daß gearbeitet wird
                
                (setq BLOCKELEMENT (entnext BLOCKELEMENT)) ; nächstes Blockelement holen, Blockende="nil"
              )                                                                 ;end [WHILE BLOCKELEMENT]
              (entupd (cdr (assoc -2 BLOCKDEF)))
            )	  
          ); .........................................................end [IF ..kein unbenannter Block..]
        )	
      )                                               ; end [IF BLOCKDEFINITION konnte ausgelesen werden]
    )            
    (setq BLOCKLISTE nil)                         ; bei falschem Parametertyp BLOCKLISTE auf "nil" setzen
  ); .......................................................................... end [BLOCKLISTE = Liste] 
  BLOCKLISTE                                        ; Liste mit allen gefundenen Blocknamen zurückliefern
)                                                                                           ; end [DEFUN]
;; --------------------------------------------------------------------------------------------------- ;;
 

;; --------------------------------------------------------------------------------------------------- ;;
;; -- UPDATE_AUSWAHL :  Bearbeitungsfunktion für Auswahlsatz. Befinden sich Blockreferenzen im      -- ;;
;;                      Auswahlsatz, so werden die dazugehörigen Blockdefinitionen auch bearbeitet  -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun UPDATE_AUSWAHL(AUSWAHL / INDEX OBJEKTDATEN BLOCKNAME BLOCKLISTE SPINSYM)  
  ;;(if (and(=(type Auswahl) 'PICKSET)(=(type UPDATE_OBJEKT) 'SUBR));Parameter o.k. und Funktion definiert?
  (if (=(type Auswahl) 'PICKSET);Parameter o.k. und Funktion definiert?
    (progn      
      (setq INDEX 0)                                                          ; Auswahlindex auf 0 setzen
      (repeat (sslength AUSWAHL)                                  ; Auswahl durchlaufen und abarbeiten...
        (setq OBJEKTDATEN (entget(ssname AUSWAHL INDEX)))                          ; Objektdaten auslesen
       
        (if (=(cdr(assoc 0 OBJEKTDATEN)) "INSERT")                        ; Element eine Blockreferenz ??
          (progn                                                                             ; .. dann ..
            (setq BLOCKNAME (cdr(assoc 2 OBJEKTDATEN)))                      ; Blockname auslesen und ...
            (if BLOCKLISTE
              (if (or (not(member (cons 0 BLOCKNAME) BLOCKLISTE))   ; wenn Blockname noch nicht in Liste,
                      (not(member (cons 1 BLOCKNAME) BLOCKLISTE)))      ; .. dann als unbearbeitet (0) in
                (setq BLOCKLISTE (append BLOCKLISTE (list (cons 0 BLOCKNAME))))        ; .. Liste ablegen
              )
              (setq BLOCKLISTE (list (cons 0 BLOCKNAME )))  ; bzw. Liste anlegen und Blocknamen speichern
	    )
          )
        )
        
        (UPDATE_OBJEKT (ssname AUSWAHL INDEX) )                 ; ==> Objektbearbeitungsfunktion aufrufen

        (setq SPINSYM (SPIN SPINSYM))             ; und in der Befehlszeile anzeigen, daß gearbeitet wird
        
        (setq INDEX(1+ INDEX))                              ; Auswahlindex erhöhen und nächstes Element..
      )                                                                                    ; end [REPEAT]

      (while (assoc 0 BLOCKLISTE)                               ;... und Blockdefinitionsliste abarbeiten
        (setq BLOCKLISTE (UPDATE_BLOCK BLOCKLISTE))              ; ==> Blockbearbeitungsfunktion aufrufen
        (setq SPINSYM (SPIN SPINSYM))             ; und in der Befehlszeile anzeigen, daß gearbeitet wird
      )	   
    )
  )     
)                                                                                           ; end [DEFUN]
;; --------------------------------------------------------------------------------------------------- ;;
;; --------------------------------------------------------------------------------------------------- ;;
  


;; .. bishierher verschwindet theor. alles in irgentwelchen Bibos




;; --------------------------------------------------------------------------------------------------- ;;
;; -- SET_BYLAYER : Überträgt die Layereigenschaften auf's Objekt                                   -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun c:SET_BYLAYER ( /  AUSWAHL MODUS)
     ;; ---------------------------------------------------------------------------------------------- ;;
     ;; -- UPDATE_OBJEKT : Bearbeitet das übergebenen Objekt                                        -- ;;
     ;; --                 SubRoutine für UPDATE_BLOCK und UPDATE_AUSWAHL                           -- ;;
     ;; ---------------------------------------------------------------------------------------------- ;;
 (defun UPDATE_OBJEKT ( OBJEKT /  OBJEKTDATEN)
      (if (=(type OBJEKT) 'ENAME)                                                    ; Parameter o.k. ?
        (progn      
          (setq OBJEKTDATEN (entget OBJEKT))                                      ; Objektdaten auslesen
          (if (assoc 8 OBJEKTDATEN) 
            (progn
              (if (=(strcase(cdr(assoc 0 OBJEKTDATEN))) "INSERT")              ; Blockreferenzen auf "0"
                (setq OBJEKTDATEN(subst(cons 8 "0")(assoc 8 OBJEKTDATEN)OBJEKTDATEN))
              )
              (progn
                ;; *************** hier ändern, was du willst *************************************** ;;
                (OBJEKT_ALLGEMEIN_SET  OBJEKT 256                                                ; Farbe
                                              nil                                                ; Layer
                                              "ByLayer"                                      ; Linientyp
                                              nil                                      ; Linientypfaktor
                                              "ByLayer" )                                ; Linienstärke
                ;; *************** hier ändern, was du willst *************************************** ;;
              )  
            )
          ) 
        )
      )  
    )
  ;; ------------------------------------------------------------------------------------------------- ;;
  ;; -- und weiter mit der Hauptfunktion...
  
  (startErrorHandler "SET_BYLAYER" 'T '(("cmdecho"  0)))
  
  (initget "G A")
  (setq MODUS (getkword (strcat "\n<G>anze Zeichnung oder <A>uswahl: <G> ")))
  (if (not MODUS) (setq MODUS "G"))                                  ; Vorgabe bei "Enter"-Eingabe setzen
  (if (= (strcase MODUS) "G")                                         ; die ganze Zeichnung bearbeiten...
    (setq AUSWAHL (ssget "X"))                                                                       
    (setq AUSWAHL (ssget))                              ; sonst gewählte Objekte (oder nichts) bearbeiten
  )  
          
  (UPDATE_AUSWAHL AUSWAHL)                  ; ==> Bearbeitungsfunktion mit ausgewählten Objekten aufrufen
  (command "._regen")                                                            ; Zeichnung regenerieren
  (princ "......... und Fertig")
  (setq UPDATE_OBJEKT nil)                                                   ; Spuren im Speicher löschen
  (EndErrorHandler)
  (princ)                                                                         ; ohne Rückgabe beenden
)                                                                                           ; end [DEFUN]
;; --------------------------------------------------------------------------------------------------- ;;


(princ "Aufruf mit :  SET_BYLAYER")