;;;---------------------------------------------------------
;;; IMBAL.LSP - Isoliert ModellBereich des Aktuellen Layouts
;;;
;;;		löscht alle Modellbereichselemente die nicht
;;;		im aktuellen Layout sichtbar sind.
;;;
;;;
;;; Version: 1.0
;;; Nov-12-2001
;;; ------------
;;; Version: 1.1
;;; Mai-22-2002
;;; ------------
;;; Version: 1.2
;;; Sep-25-2002
;;;
;;;
;;; Log 1.1: IMBAL löscht nun auch ueberfluessige Layouts,
;;;          stellt auf Wunsch die Konturen der VPorts im
;;;          Modellbereich dar und bereinigt die Zeichung.
;;;          Außerdem wurden einige Probleme mit polygonalen
;;;          VPorts (hoffentlich) beseitigt.
;;;
;;; Log 1.2: Probleme mit der Anzeige der Plotstile behoben.
;;;
;;;
;;;    Viel Spass damit.
;;;
;;;    Bei Problemen mit IMBAL: eMail an CADchup@cad.de
;;;---------------------------------------------------------
;;
;;
;;;IMBAL Hauptprogramm
(defun C:IMBAL (/	    act-ctab	ss	    id
		nodelete    nodelete-r	id	    idcount
		pointlist   vportelements	    eledex
		eledel	    loquestion	vp2ms
	       )
  (vl-load-com)
  (X-init)
  (X-VarSet '("CMDECHO" "OSMODE" "FILEDIA"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (if (= 0 (getvar "TILEMODE"))
    (progn
      (command "_.pspace" "_.zoom" "_e")
      (setq showpstyle (vla-get-showplotstyles (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))
      (if (= :vlax-true showpstyle)
	(vla-put-showplotstyles (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))) :vlax-false); Anzeige der Plotstile unterdrücken
	); if
      (VP2MS?)
      (princ
	"\nEinen Moment bitte. IMBAL löscht alle in diesem Layout unbenutzten Zeichnungselemente..."
      )
      (DelLayouts)			; alle Layouts bis auf das aktuelle löschen
      (setq act-ctab (getvar "CTAB"))	; aktuelles Layout holen
      (setq ss (ssget "X"
		      (list (cons -4 "<AND")
			    (cons 0 "VIEWPORT")
			    (cons 410 act-ctab)
			    (cons -4 "<NOT")
			    (cons 69 1)
			    (cons -4 "NOT>")
			    (cons -4 "AND>")
		      )
	       )			; alle vports bis auf das Papierbereichsfenster
      )
      (vportIDextraction ss)		; IDs der gefundenen vports extrahieren
      (setq nodelete (ssadd))		; schon mal einen leeren Auswahlsatz für später bilden
      (setq nodelete-r (ssadd))		; schon mal einen leeren Auswahlsatz für später bilden
      (setq idcount -1)
      (command "_.mspace")
      (while (and idcount (< (setq idcount (1+ idcount)) (length id)))
	(setvar "CVPORT" (nth idcount id))
					; ersten gefundenen vport aktivieren
	(setq pointlist (cdar (vports)))
	(setq
	  pointlist
	   (mapcar '(lambda (pnt) (trans (trans pnt 3 2) 2 1))
		   pointlist
	   )				; mapcar
	)				; setq Punkte transformieren
	(if (= 1 vp2ms)
	  (Vport2Pline pointlist)	; VPort-Konturen im Modellberech zeichnen
	)				; if
	(setq vport-extmin (car pointlist))
	(setq vport-extmax (cadr pointlist))
	(setq vportelements (ssget "_c" vport-extmin vport-extmax))
					; Elemente, die im vport sichtbar sind wählen
	(setq eledex 0)
	(if vportelements
	  (repeat (sslength vportelements)
	    (setq
	      nodelete (ssadd (ssname vportelements eledex) nodelete)
	    )
					; und einen Auswahlsatz draus basteln
	    (setq eledex (1+ eledex))
	  )				; repeat
	)				; if
	(if (= 1 vp2ms)
	  (setq nodelete-r (ssadd (entlast) nodelete-r))
	)				; if
      )					; while
      (setq eledel (ssget "x" '((-4 . "<NOT") (67 . 1) (-4 . "NOT>"))))
					; Auswahlsatz über alle Elemente im Modellbereich
      (if eledel
	(progn
	  (setq eledex 0)
	  (repeat (sslength eledel)
	    (if	(not (or (ssmemb (ssname eledel eledex) nodelete)
			 (ssmemb (ssname eledel eledex) nodelete-r)
		     )
		)
	      (entdel (ssname eledel eledex))
	    )				; if
	    (setq eledex (1+ eledex))
	  )				; repeat
	)				; progn
      )					; if
      (command "_.pspace")
      (princ "\n\nZeichnung wird bereinigt...")
      (repeat 5
	(vlax-invoke-method
	  (vla-Get-ActiveDocument
	    (vlax-Get-Acad-object)
	  )
	  'PurgeAll
	)
      )					; repeat
      (if (= :vlax-true showpstyle)
	(vla-put-showplotstyles (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))) :vlax-true); Anzeige der Plotstile wiederherstellen
	); if
      (initget "Nein Ja")
      (setq loquestion
	     (getkword
	       "\n\nZeichnung unter Layoutnamen speichern <J/N> [Ja]"
	     )
      )
      (if (= "Nein" loquestion)
	(progn
	  (initdia)
	  (command "_.saveas")
	)				; progn
	(progn
	  (setvar "FILEDIA" 0)
	  (command "_.saveas"
		   ""
		   (strcat (getvar "DWGPREFIX") (getvar "CTAB"))
	  )
	)				; progn
      )					; if
    )					; progn
    (alert
      "\nHOPPERLA!\nWir sind ja im Modellbereich. Wenn jetzt ein Layout aktiv wäre, ja, dann könnte ich vielleicht loslegen...\nAlso: Layout wählen und nochmal starten."
    )
  )					; if
  (X-VarReset)
  (setq *error* x-err)
  (princ)
)					; defun
;;;Ende des Hauptprogramms
;;
;;
(defun dxf (code elist)
  (cdr (assoc code elist))
)					; defun
;;
;;
;;; Fragen, ob VPorts im Modell gezeigt werden sollen
(defun VP2MS? (/ vpmsquestion)
  (initget "Nein Ja")
  (setq	vpmsquestion
	 (getkword
	   "\n\nSollen die Ansichtsfensterkonturen in den Modellbereich uebertragen werden? <J/N> [Ja]"
	 )
  )
  (if (= "Nein" vpmsquestion)
    (setq vp2ms 0)
    (setq vp2ms 1)
  )					; if
)					; defun
;;
;;
;;; VPort im Modellbereich zeichnen
(defun Vport2Pline (plist / P1 P2 P3 P4)
  (setq	P1 (nth 0 plist)
	P2 (list (nth 0 (nth 1 plist)) (nth 1 P1))
	P3 (nth 1 plist)
	P4 (list (nth 0 P1) (nth 1 P3))
  )
  (command "_pline" P1 P2 P3 P4 "_close")
)					; defun
;;
;;
;;; alle Layouts bis auf das aktuelle löschen
(defun DelLayouts (/ lolist)
  (setq lolist (vl-remove (getvar "CTAB") (layoutlist)))
  (foreach n lolist
    (command "_-layout" "_del" n)
  )
)					; defun
;;
;;
;;; Extrahiert Viewport-IDs
(defun vportIDextraction (ss / index)
  (setq index 0)
  (repeat (sslength ss)
    (setq
      id (append id
		 (list (cdr (assoc 69 (entget (ssname ss index)))))
	 )
    )
    (setq index (1+ index))
  )					; repeat
)					; defun
;;
;;
(defun X-init (/ x-echo)
  (setq x-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq	x-err	*error*
	*error*	X-Error
  )
  (command "_UNDO" "_MARK")
  (setvar "CMDECHO" x-echo)
)					;defun
;;
;;
(defun X-VarSet	(x-a)
  (setq x-vars '())
  (repeat (length x-a)
    (setq
      x-vars (append x-vars
		     (list (list (car x-a) (getvar (car x-a))))
	     )
      x-a    (cdr x-a)
    )					; setq
  )					; repeat
)					; defun
;;
;;
(defun X-VarReset ()
  (repeat (length x-vars)
    (setvar (caar x-vars) (cadar x-vars))
    (setq x-vars (cdr x-vars))
  )					; repeat
)					;defun
;;
;;
(defun X-Error (s)
  (print (strcat "Fehler " s))
  (command)
  (command "_UNDO" "_BACK")
  (setq *error* x-err)
  (princ)
)					; defun
;;
;;
(princ
  "\n\nIMBAL wurde geladen. <I>soliert <M>odell<B>ereich des <A>ktuellen <L>ayouts."
)
(princ
  "\nStart mit der Eingabe von IMBAL."
)
(princ)