;*******************************************************************************************************
; Programmentwickler: Henning Jesse                                                                     
;													
;*******************************************************************************************************
; Datei : abblenden2009.LSP                                                                             
; Lisp-Routine zum Abblenden eines beliebigen Bereichs eines Ansichtfensters                            
;                                                                                                       
; basiert auf abblend.lsp v. 11.03.2006 von mir                                                         
; Status: beta                                                                                          
; begonnen: 10.05.2008                                                                                  
; letzte Änderung: 10.02.2009                                                                           
; todo: Ist vp_border bereits eine Region, bleibt diese ZUSÄTZLICH erhalten???                          
;                                                                                                       
; seit 2009 Zugriff auf af-Überschreibung im Befehl _vplayer möglich! jetzt einfacher..                 
;*******************************************************************************************************

(defun c:abblenden ( / ab_color ab_width ak_layer ak_delobj vp vp_border vp_clip vp_neu)
  (setq ab_color 253 ab_width 0.0);Farbe und Liniestärke der Abblendung einstellen
  (prompt "Ansichtsfenster wählen:\n")
  (setq vp (ssget "_:S" '((0 . "VIEWPORT"))))
  (if vp
    (progn
      (prompt "Beschneidungsobjekt (Polylinie/Kreis/Region) wählen:\n")
      (setq vp_clip (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,REGION"))))
      (if vp_clip
        (progn
          (setq vp (ssname vp 0))
          (setq vp_clip (ssname vp_clip 0))
          (setvar "cmdecho" 0)
          (command "_undo" "_be")
          (setq ak_delobj (getvar "delobj"))
          (setvar "delobj" 1)
          (setq ak_layer (getvar "clayer"))
          (setvar "clayer" (cdr (assoc 8 (entget vp))))
          (setq vp_border (get-vp-border vp));Begrenzungsrahmen des zu beschneidenden AF's ermitteln
          (if (/= (cdr (assoc 0 (entget vp_border))) "REGION")
            (progn
              (command "_region" vp_border "");Region erzeugen
              (setq vp_border (entlast))
    	    )
          )
          (if (/= (cdr (assoc 0 (entget vp_clip))) "REGION")
    	    (progn
              (command "_region" vp_clip "");Region erzeugen
              (setq vp_clip (entlast))
    	    )
          )
          (command "_copy" vp_clip "" '(0 0 0) '(0 0 0))
          (command "_subtract" vp_border "" (entlast) "");Objektname vp_border bleibt erhalten!
          (command "_vports" "_layer" "_yes" vp "")
          (command "_copy" vp "" '(0 0 0) '(0 0 0))
          (setq vp_neu (entlast))
          (command "_vpclip" vp_neu vp_border)
          (command "_vpclip" vp vp_clip)
          (command "_vplayer" "_color" ab_color "*" "_Select" vp_neu "" "_LWeight" ab_width "*" "_Select" vp_neu "" "")
          (setvar "clayer" ak_layer)
          (setvar "delobj" ak_delobj)
          (command "_undo" "_end")
          (setvar "cmdecho" 1)
        )
      )
      (prompt "kein gültiges Beschneidungsobjekt gewählt")
    )
    (prompt "kein Ansichtsfenster gewählt")
  )
  (prin1)
)

; get-vp-border erzeugt ein Objekt, das der Beschneidung eines AF entspricht
; Übergabe: name eines Ansichtfensters (Viewport)
; Rückgabe: Name des erzeugten Beschneidungsobjektes
(defun get-vp-border (vp / border vp_prop zen b h x y)
  (or
    (if (setq border (cdr (assoc 340 (setq vp_prop (entget vp)))));vp hat Umgrenzung
      (entmake (cdr (entget border)));neues Objekt erzeugen mit den Eigenschaften der Umgrenzung
    )
    (progn;vp hat keine Umgrenzung -> Umgrenzung errechnen und erzeugen
      (setq zen (cdr (assoc 10 vp_prop)))
      (setq b (cdr (assoc 40 vp_prop)))
      (setq h (cdr (assoc 41 vp_prop)))
      (command "_pline"
               (list (setq x (- (car zen) (/ b 2))) (setq y (- (cadr zen) (/ h 2))))
               (list (+ x b) y)
               (list (+ x b) (+ y h))
               (list x (+ y h))
               "_c"
      )
    )
  )
  (entlast)
)