;*******************************************************************************************************
; Programmentwickler: Henning Jesse                                                                     
;													
;*******************************************************************************************************
; Datei : abblenden.LSP                                                                                 
; Lisp-Routine zum Abblenden eines rechteckigen Bereichs eines Ansichtfensters                          
;                                                                                                       
; Status: beta                                                                                          
; begonnen: 11.03.2006                                                                                  
; letzte Änderung: 13.03.2006                                                                           
;*******************************************************************************************************

(defun c:abblenden ( / grau abblend-xref-layer abblend-xref ak_layer af p0 b h p1 p2 p3 p4 p5 p6 p7 af_fr lay_vis marker af-neu)
  (setvar "cmdecho" 0)
  (command "_undo" "_be")
  (setq grau 254
        abblend-xref-layer (strcat(substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) "-abblend")
        abblend-xref (strcat (getvar "dwgprefix") abblend-xref-layer ".dwg")
  )
  (setq ak_layer (getvar "clayer"))
  (setq af (car (entsel "Ansichtsfenster wählen:\n")))
  (setq p0 (cdr (assoc 10 (entget af))))
  (setq b (cdr (assoc 40 (entget af))))
  (setq h (cdr (assoc 41 (entget af))))
  (setq p0 (list (- (car p0) (/ b 2)) (- (cadr p0) (/ h 2))))
  (setq p1 (list (+ (car p0) b) (cadr p0)))
  (setq p2 (list (+ (car p0) b) (+ (cadr p0) h)))
  (setq p3 (list (car p0) (+ (cadr p0) h)))
  (setq p4 (getpoint "linke untere Ecke:"))
  (setq p6 (getcorner p4 "rechte obere Ecke:"))
  (setq p5 (list (car p6) (cadr p4)))
  (setq p7 (list (car p4) (cadr p6)))
  (foreach n (mapcar 'cdr (multi-assoc 331 (entget af)))
    (setq af_fr (cons (cdr (assoc 2 (entget n))) af_fr))
  );liste gefrorener Layer
  (setq lay_vis (subst_liste (get-layer-liste) af_fr));liste sichtbarer Layer
  (command "-afenster" "ein" af "")
  (command "_.mspace")
  (setq marker (entlast))
  (setq alle (ssget "X"))
  (setq x-block (ssget "x" (list (cons 0 "INSERT") (cons 2 abblend-xref-layer))))
  (setq zaehler 0)
  (if x-block
    (while (setq ele (ssname x-block zaehler))
      (setq alle (ssdel ele alle) zaehler (1+ zaehler))
    )
  )
  (command"_layer" "_ma" abblend-xref-layer "_co" grau "" "")
  (if (not (findfile abblend-xref))
    (command "_-wblock" abblend-xref "" (trans '(0 0 0) 1 0) alle "" "_oops")
    (progn
      (initget "Ja Nein")
      (setq ant (getkword "Referenz existiert! aktualisieren? <Ja> Nein:"))
      (if (or (not ant) (= ant "Ja")) (command "_-wblock" abblend-xref "_y" "" (trans '(0 0 0) 1 0) alle "" "_oops"))
    )
  )
  (if(tblsearch "Block" abblend-xref-layer)
    (prompt "Xref bereits definiert, aktuelle Zuordnung wird verwendet!\n")
    (progn
      (command "_-xref" "zuordnen" abblend-xref (trans '(0 0 0) 0 1) "" "" "")
      (command "_draworder" (entlast) "" "unten")
    )
  )
  (command "_.pspace")
  (command"_layer" "_ma" (strcat abblend-xref-layer "afenster") "_co" grau "" "")
  (command "_copy" af "" '(0 0 0) '(0 0 0))
  (setq af-neu (entlast))
  (command "_change" af-neu "" "_p" "_la" (strcat abblend-xref-layer "afenster") "")
  (command "_pline" p0 p1 p2 p3 p7 p6 p5 p4 p7 p3 "_c")
  (command "_vpclip" af-neu (entlast))
  (command "_layer" "_se" (cdr (assoc 8 (entget af))) "")
  (command "_pline" p4 p5 p6 p7 "_c")
  (command "_vpclip" af (entlast))
  (command "_layer" "_se" ak_layer "")
  (command "-afenster" "ein" af-neu "")
  (command "_.mspace")
  (command "_vplayer")
  (foreach n (get-layer-liste)
    (if (not (= (strcase (substr n 1 (strlen abblend-xref-layer))) (strcase abblend-xref-layer)))
      (command "_f" n "")
      (if (member (substr n (+ 2 (strlen abblend-xref-layer))) af_fr)
        (command "_f" n "")
      )
    )
  )
  (command "")    
  (command "_.pspace")
  (command "_layer")
  (foreach n (get-layer-liste)
    (if (= (strcase (substr n 1 (strlen abblend-xref-layer))) (strcase abblend-xref-layer))
      (command  "_co" grau n)
    )
  )
  (command "")    
  (command "-afenster" "ein" af "")
  (command "_.mspace")
  (command "_vplayer")
  (foreach n (get-layer-liste)
    (if (= (strcase (substr n 1 (strlen abblend-xref-layer))) (strcase abblend-xref-layer))
      (command "_f" n "")
    )
  )
  (command "")    
  (command "_.pspace")
  (command "_layer" "_off" (strcat abblend-xref-layer "afenster") "")
  (command "_undo" "_e")
  (setvar "cmdecho" 1)
  (prin1)
)


;*******************************************************************************************************
;                  											
; multi-assoc liefert zu einer Liste ALLE Assoziationselemente zurück und nicht nur das erste wie assoc 
;                                                                                                       
;                                                                                                       
;Rückgabe: wie assoc                                                                                    
;*******************************************************************************************************
(defun multi-assoc (key liste / return)
  (if (and liste (setq return (assoc key liste)))
    (cons return (multi-assoc key (cdr (member return liste))))
  )
)


;*******************************************************************************************************
;                  											
; get-layer-liste liest die aktuell in der Zeichnung vorhandenen Layer aus                              
;                                                                                                       
;                                                                                                       
;Rückgabe: Liste der Layer                                                                              
;*******************************************************************************************************
(defun get-layer-liste ( / la la_ls lay_det lay_nam layer_liste)
  (setq lay_det (tblnext "layer" t))
    (while lay_det
      (setq lay_nam (cdr (assoc 2 lay_det)))
      (setq layer_liste (cons lay_nam layer_liste))
      (setq lay_det (tblnext "layer"))
    )
  (setq lay_det nil)
  (setq layer_liste (vl-sort layer_liste '<))
)


;*******************************************************************************************************
;                  											
; subst_liste entfernt aus Liste ls1 die Elemente in Liste ls2                                          
;                                                                                                       
;                                                                                                       
;Rückgabe: Liste mit entfernten Elementen                                                               
;*******************************************************************************************************
(defun subst_liste (ls1 ls2 / )
  (foreach n ls1
    (if (not (member n ls2))
      (setq ergebnis (cons n ergebnis))
    )
  )
  (reverse ergebnis)
)