;;; Programm zum Plotten von einzelnen Layern		;
;;; --------------------------------------------;

;;; Autor: Jascha Lendeckel


;;; Dialogfeld laden
(defun ladeDialog (strDatei strDialog strTitel
		   / intDialogID   strPfadDatei)
  (if (not (setq strPfadDatei (findfile strDatei)))
    (progn
      (princ
				(strcat	"\nDatei " strDatei
					" nicht gefunden. \nBitte Suchpfad für Support-"
					"Dateien unter Extras/Optionen/Dateien eintragen. "
				)
      )
      (exit)
    )
    (progn
      (setq intDialogID (load_dialog strPfadDatei))
      (if (not (new_dialog strDialog intDialogID))
				(progn
				  (princ (strcat "\nDialog " strDialog " nicht vorhanden. "))
				  (exit)
				)
				(set_tile "titel" strTitel)
      )
    )
  )
  intDialogID
)


;;; Dialogfeld anzeigen
(defun zeigeDialog (intDialogID / intStatus)
  (setq intStatus (start_dialog))
  (unload_dialog intDialogID)
  (cond
    ((= intStatus 1) T)
    (T nil)
  )
)


; Suche einer Zeichenkette innerhalb einer anderen Zeichenkette und gibt deren Position;
; zurück.
(defun instr (intStartPos strQuelle strSuche / i intMax intRet intLen)
	(setq intMax (strlen strQuelle))
	(setq intLen (strlen strSuche))
	
	(setq i intStartPos)
	(while (<= i intMax)
		(if (= strSuche (substr strQuelle i intLen))
			(progn
				(setq intRet i)
				(Setq i (1+ intMax))
			)
			(setq i (1+ i))
		)
	)
	intRet
)


; Diese Prozedur ermittelt Datum und Uhrzeit  und gibt es als Strung zurück
; Formatierung "TT.MM.JJ SS:MM Uhr"

 (defun DATUM  ( / strDATUM strTXT)
  (setq strDATUM (rtos (getvar "CDATE") 2 10))
  (setq strTXT
   (strcat
    (substr strDATUM 7 2)    ;Tag
    "."
    (substr strDATUM 5 2)    ;Monat
    "."
    (substr strDATUM 3 2)    ;Jahr
    " "
    (substr strDATUM 10 2)   ;Stunden
    ":"
    (substr strDATUM 12 2)   ;Minuten
    " UHR"
   )
  )
 )

;----------------------------------------------------------;
; Autor: Jascha Lendeckel
; Datum: 21.05.04
;----------------------------------------------------------;
; Funktion: Liste füllen ;
; Die Funktion füllt eine Liste von Zahlen im ASCII-Format ;
; Aus ("1" "5" "7") wird ("1" "2" "3" "4" "5" "6" "7") ;
;----------------------------------------------------------;
(defun listfuell (Liste / strZahl intZahl1 intZahl2 Zielliste i)
	(setq Zielliste (cons (car Liste) Zielliste))
	(foreach strZahl Liste
		(setq intZahl2 intZahl1)
		(setq intZahl1 (atoi strZahl))
		(IF (AND intZahl1 intZahl2)
			(IF (OR (< intZahl1 intZahl2) (= intZahl1 intZahl2))
				(setq Zielliste 'NIL)
				(progn
					(setq i (- intZahl1 intZahl2))
					(repeat i
						(setq intZahl2 (1+ intZahl2))
						(setq Zielliste (cons (itoa intZahl2) Zielliste))
					)
				)
			)
		)
	)
	(reverse Zielliste)
)

; Alle definierten Plotter ermitteln
(defun C:GetPlotDevices ( / ad prnlist)
  (vl-load-com)
  (setq ad (vla-get-activedocument (vlax-get-acad-object)))
  (vla-RefreshPlotDeviceInfo
  (vla-get-activelayout ad))
  (setq prnlist
  (vlax-safearray->list
    (vlax-variant-value
      (vla-getplotdevicenames
        (vla-item (vla-get-layouts ad) "Model")))))
)
   
; Den aktuellen Systemdrucker ermitteln
(defun C:GetActivePlotDevice ( / ad active)
  (vl-load-com)
  (setq ad (vla-get-activedocument (vlax-get-acad-object)))
  (setq active
  (vla-get-ConfigName
    (vla-get-ActiveLayout ad)))
)
 
;----------------------------------------------------------;
; Autor: Jascha Lendeckel
; Datum: 20.05.04
;----------------------------------------------------------;
; Funktion: Zeichenkette in Liste umwandeln ;
; Die Funktion liefert eine Liste von Elementen, die in der
; Zeichnkette [strSeiten] enthalten und durch ein
;  Trennzeichen [strTeiler] getrennt sind.
;----------------------------------------------------------;
(defun Seitenliste (strSeiten strTeiler1 strTeiler2 / Liste intPos i strElement Liste2)

	; Zuerst wird sichergestellt das das letzte Zeichen der Zeichenkette [strSeiten] gleich
	; [strTeiler1] (Trennzeichen) ist, wenn nicht wird das Trennzeichen an die ZK angehängt.
	(if (/= (Substr strSeiten (strlen strSeiten) 1) strTeiler1)
		(setq strSeiten (strcat strSeiten strTeiler1))
	)

	(setq i 1) ; Positionszähler für Schleife

	(while (setq intPos (instr i strSeiten strTeiler1))
		(setq strElement (substr strSeiten i (- intPos i)))
		(IF (AND strTeiler2 (instr 1 strElement strTeiler2))
			(progn
				(setq liste2 (reverse (listfuell (Seitenliste strElement strTeiler2 NIL))))
				(setq liste (append liste2 liste))
			)
			(setq liste (cons strElement liste))
		)
		(setq i (1+ intpos))
	)
	(reverse liste)
)


;----------------------------------------------------------;
; Autor: Jascha Lendeckel
; Datum: 21.05.04
;----------------------------------------------------------;
; Funktion: Element in Liste suchen ;
; Die Funktion sucht ein Element in einer Liste und gibt;
; dessen Position beginnent mit Null zurück.
;----------------------------------------------------------;
(defun inlist (
							 ; Übergabe Variablen
							 SuchElement		; Gesuchtes Element
							 lst_Liste			; Liste ind der gesucht wird
							/; Locale Variablen
							 int_Position		; Gefunden Position
							 i							; Schleifenzähler
							 Element				; Teil der Liste
							 )
	(setq i 0)
	(foreach Element lst_Liste
		(If (AND (= Element SuchElement) (NOT int_Position))
			(setq int_Position i)
			(setq i (1+ i))
		)
	)
	int_Position
)


(defun Layerauswahl (/ li ele)
; erzeugt eine Liste mit allen Layernamen

	(setq li 'nil)

	(setq ele (tblnext "LAYER" 'T)) ;ersten Layer suchen
	(setq li (cons (cdr (assoc 2 ele)) li))

	(while (setq ele(tblnext "LAYER")) ;weitere Layer suchen
		(setq li (cons (cdr (assoc 2 ele)) li))
	); while

	(setq li (reverse li)) ;Rückgabewert

)


(defun Blockauswahl (/ li ele test1)
; erzeugt eine Liste mit allen Layernamen

	(setq li 'nil)

	(setq test1 (ssget (list (cons 0 "INSERT")(cons 8 "003"))))

	(setq ele (tblnext "Block" 'T)) ;ersten Layer suchen
	(setq li (cons (cdr (assoc 2 ele)) li))

	(while (setq ele(tblnext "Block")) ;weitere Layer suchen
		(setq li (cons (cdr (assoc 2 ele)) li))
	); while

	(setq li (reverse li)) ;Rückgabewert

)


;; Druckroutiene ;;
(defun Seite_Drucken (Drucker Datei)
	(Setvar "CMDECHO" 0)		;Unterdückt die Ausgabe der Befehlsaufrufe während der Funktion
	(command "-PLOT"
		""				;Detaillierte Konfiguration (DEFAULT: NEIN)
		""				;Lyoutname eingeben (DEFAULT: Model)
		""				;Name der Seiteneinrichtung eingeben (DEFAULT: )
		Drucker		;Ausgabegerät eingeiben (DEFAULT: 'Standart Plotter der Zeichnung')
		Datei			;Plotten in Datei (DEFAULT: NEIN)
		""				;Änderungen im Register Modell speichern (DEFAULT: NEIN)
		""				;Plotten (DEFAULT: JA)
	)
	(princ)									; Unterdückt die Ausgabe des Rückgabewertes
)

	
;  Hauptprogramm  ;
(defun c:eplot (/
	lst_Layer	  ; Liste aller Layer der Zeichnung
	lst_Layer_Auswahl ; Liste aller Seiten der Zeichnung (Ohne Inahlt u. Deckblatt)
	int_DialogID  		; ID des Eingabedialogs
	str_aktiv_Drucker	; aktiver Drucker
	str_ausgabe_Drucker	; aktiver Drucker
	str_vorwahl_Drucker ; 
	lst_Druckerliste  	; Liste aller zur Auswahl stehenden Drucker
	str_Datei     		; Plotten in Datei => 0 = "NEIN" / 1 = "JA"
	str_Reverse		; Seiten umkehren =>  0 = "NEIN" / 1 = "JA"
	str_Seiten    		; Auszudruckende Seiten als String
	lst_Seiten    		; Liste der zu druckenden Seiten
	lst_Liste1		; Hilfsliste
	str_Element   		; Ein Element der Seitenliste
	int_Len			; Länge eines Strings
	str_Auswahl_Alle 	; Button Druckbereich = Alles drucken
	str_Auswahl_Seiten  	; Button Druckbereich = Auswahl drucken
	obj_Name		; Objektname (hier Objekt_Name des Layers
	lst_ObjLayer		; Objektliste Layer
	str_aktiv_Layer	  ; Vor Plottbeginn aktiver Layer
								)

	(Setvar "CMDECHO" 0)	;Unterdückt die Ausgabe der Befehlsaufrufe während der Funktion

	;; Layerliste einlesen und druckbare Seite filtern
	(setq lst_Layer (Layerauswahl))
	(foreach str_Element lst_Layer
		(If (> (atoi str_Element) 0)
			(setq lst_Layer_Auswahl (cons str_Element lst_Layer_Auswahl))
		)
	)
	(setq lst_Layer_Auswahl (acad_strlsort lst_Layer_Auswahl))
	
	;; Dialogfeld laden...

	(setq	intDialogID
		(ladeDialog
		"Plot_Layer.dcl"
	   	"Plot_LayerDialog"
	   	"Layer Plotten"
		)
  )

	;; ...Vorgabeposition setzen

	(setq str_aktiv_Drucker (C:GetActivePlotDevice))
	(setq lst_Druckerliste (cdr (C:GetPlotDevices)))
	(start_list "Drucker")
		(foreach str_Element lst_Druckerliste
			(add_list str_Element)
		)
	(end_list)
	(setq str_vorwahl_Drucker (inlist str_aktiv_Drucker lst_Druckerliste))
	(IF str_vorwahl_Drucker
		(setq str_vorwahl_Drucker (itoa str_vorwahl_Drucker))
		(setq str_vorwahl_Drucker "0")
	)
	(setq str_ausgabe_Drucker (nth (atoi str_vorwahl_Drucker) lst_Druckerliste))
	(set_tile "Drucker" str_vorwahl_Drucker)
	(setq str_Datei "0")
	(set_tile "InDatei" str_Datei)
	(setq str_Reverse "0")
	(set_tile "Reverse" str_Reverse)
	(setq str_Auswahl_Alle "1")
	(set_tile "Alle" str_Auswahl_Alle)
	(setq str_Auswahl_Seiten "0")
	(set_tile "Seiten" str_Auswahl_Seiten)
	(action_tile "Drucker"
		"(setq str_ausgabe_Drucker $value)"
	)
	(action_tile "InDatei"
		"(setq str_Datei $value)"
	)
	(action_tile "Reverse"
		"(setq str_Reverse $value)"
	)
	(action_tile "Seiten"
		"(setq str_Auswahl_Seiten $value)
	  (Setq str_Auswahl_Alle \"0\")"
	)
	(action_tile "Alle"
		"(setq str_Auswahl_Alle $value)
		(Setq str_Auswahl_Seiten \"0\")"
	)
	(action_tile "Auswahl"
		"(setq str_Seiten $value)
		(Setq str_Auswahl_Seiten \"1\")
		(set_tile \"Seiten\" str_Auswahl_Seiten)"
	)
	
	(if (zeigeDialog intDialogID)
		(progn
			; Auswertung Ausgabe auf Drucker oder in Datei
			(if (= str_Datei "0")
				(setq str_Datei "Nein")
				(setq str_Datei "Ja")
			)
			; Welche Seiten werden gedruckt?
			(if (= str_Auswahl_Seiten "1")
				; Auswahl von zu druckenden Seiten ermitteln
				(progn
					; Erstellen der Liste der zu druckenden Seiten
					(setq lst_Seiten (Seitenliste str_Seiten "," "-"))
					; Liste aufarbeiten so das Seitenzahlen den Layernamen entsprechen
					(setq lst_Liste1 '())
					(foreach str_Element lst_Seiten
						(setq str_Element (strcat "00" str_Element))
						(Setq int_Len (strlen str_Element))
						(setq str_Element (substr str_Element (- int_Len 2) 3))
						(setq lst_Liste1 (cons str_Element lst_Liste1))
					)
					(Setq lst_Seiten (acad_strlsort lst_Liste1))
					(IF (= str_Reverse "1")
						; Wenn "Seiten umkehren" gewählt wurde wird die Liste absteigend sortiert
						(Setq lst_Seiten (reverse lst_Seiten))
					)
				)
				; Alle Seiten drucken
				(setq lst_Seiten lst_Layer_Auswahl)
			)
			; zuerst wird Layer null als Aktiver Layer gesetzt.
			(command "-LAYER" "t" "0" "se" "0" "")
			; bevor mit dem Druckvorgang begonnen werden kann,
			; werden erst alle Seiten gefroren
			(foreach str_Element lst_Layer_Auswahl
				; Objektname des zu bearbeitenden LAYER ermitteln
				(setq obj_Name (tblobjname "LAYER" str_Element))
				; mit dem Objektnamen kann die Vollständige Entity-Liste des
				; Layers geöffnet werden
				(setq lst_ObjLayer (entget obj_Name))
				(IF (= (cdr (assoc 70 lst_ObjLayer)) 0)
					(progn
						; Ändern des Zustandes des Layers auf gefrohren
						; ACHTUNG es wird davon ausgegangen das außer der Option Frieren/Tauen
						; keine Optionen des DXF-Code 70 verwendet werden.
						(setq lst_ObjLayer (subst '(70 . 1) '(70 . 0) lst_ObjLayer))
						; gänderte Entiy-Liste in die Datenbank zurück schreiben
						(entmod lst_ObjLayer)
						(setq str_aktiv_Layer str_Element)
					)
				)
			)
			; Jetzt werden alle Seiten nacheinander aufgetaut und gedruckt
			(foreach str_Element lst_Seiten
;;;				; Objektname des zu bearbeitenden LAYER ermitteln
;;;				(setq obj_Name (tblobjname "LAYER" str_Element))
;;;				; mit dem Objektnamen kann die Vollständige Entity-Liste des
;;;				; Layers geöffnet werden
;;;				(setq lst_ObjLayer (entget obj_Name))
;;;				; zu plottenden Layer auftauen
;;;				(setq lst_ObjLayer (subst '(70 . 0) '(70 . 1) lst_ObjLayer))
;;;				; gänderte Entiy-Liste in die Datenbank zurück schreiben
;;;				(entmod lst_ObjLayer)

				(command "-LAYER" "t" str_Element "")
				
				; Seite Plotten

				(Seite_Drucken str_ausgabe_Drucker str_Datei)
				
				;geplotteten Layer wieder einfriern

				(command "-LAYER" "fr" str_Element "")
;;;				(setq lst_ObjLayer (subst '(70 . 1) '(70 . 0) lst_ObjLayer))
;;;				(entmod lst_ObjLayer)
			) ; END foreach
			(command "-LAYER" "t" str_aktiv_Layer "")
		)
    (princ "\nDialog mit Abbrechen verlassen. ")
  )
	(Setvar "CMDECHO" 1)		; Freigabe der Befehlaufrufe
  (princ)
)

(defun c:gehezu (/
								 str_Layer
								 lst_Layer
								 lst_Layer_Auswahl
								 str_Element
								 obj_Name
								 lst_ObjLayer
								 int_RahmenA
								 int_RahmenB
								 int_RahmenC
								 int_RahmenD
								)

	;; Eingabe Layer
	(while (not str_Layer)
		(setq str_Layer (getstring T " Layername: "))
	)
	(setq int_RahmenA (getint " Rahmen 0A: <0/1>"))
	(setq int_RahmenB (getint " Rahmen 0B: <0/1>"))
	(setq int_RahmenC (getint " Rahmen 0C: <0/1>"))
	(setq int_RahmenD (getint " Rahmen 0D: <0/1>"))
	
	;; Layerliste einlesen und druckbare Seite filtern
	(setq lst_Layer_Auswahl (Layerauswahl))
	(If (AND (> (atoi str_Layer) 0) (< (strlen str_Layer) 3))
		(setq str_Layer (substr (strcat "00" str_Layer) (- (strlen (strcat "00" str_Layer)) 2) 3))
	)

	(foreach str_Element lst_Layer_Auswahl
		; Objektname des zu bearbeitenden LAYER ermitteln
		(setq obj_Name (tblobjname "LAYER" str_Element))
		; mit dem Objektnamen kann die Vollständige Entity-Liste des
		; Layers geöffnet werden
		(setq lst_ObjLayer (entget obj_Name))
		(IF (= (cdr (assoc 70 lst_ObjLayer)) 0)
			(progn
				; Ändern des Zustandes des Layers auf gefrohren
				; ACHTUNG es wird davon ausgegangen das außer der Option Frieren/Tauen
				; keine Optionen des DXF-Code 70 verwendet werden.
				(setq lst_ObjLayer (subst '(70 . 1) '(70 . 0) lst_ObjLayer))
				; gänderte Entiy-Liste in die Datenbank zurück schreiben
				(entmod lst_ObjLayer)
			)
		)
	)
	(command "-LAYER" "t" str_Layer "se" str_Layer "")
	(If (= int_RahmenA 1) (command "-LAYER" "t" "0A" ""))
	(If (= int_RahmenB 1) (command "-LAYER" "t" "0B" ""))
	(If (= int_RahmenC 1) (command "-LAYER" "t" "0C" ""))
	(If (= int_RahmenD 1) (command "-LAYER" "t" "0D" ""))
	(command "-LAYER" "t" "0" "")
)

(defun test (/ objektauswahl objektanzahl objektname
						 objektliste
						 objektliste2
						 objektliste2_1
						 objektliste2_2
						 objektliste2_3)
	(setq objektauswahl (ssget "X" (list (cons 0 "INSERT")(cons 8 "003"))))
	;; ssget erstellt einen Auswahlsatz von Objektnamen
	(setq objektanzahl (sslength objektauswahl))
	;; sslength ermittelt die Anazhl der Objekte eines Auswahlsatzes
	(while (> objektanzahl 0)
  	(setq objektanzahl (1- Objektanzahl))
		(setq objektname (ssname objektauswahl objektanzahl))
		;; ssname gibt das n-te Objekt eines Auswahlsatzes zurück
		; (setq objektliste (entget objektname))
		(setq objektliste (ALL-BL-TXT objektname))
	)
)

;;; Funktion durchsucht den Block, der über ename übergeben wird,
;;; nach ATTRIB's und erzeugt 'ne Textliste
;;; Retval: Liste der Texte oder nil
(defun ALL-BL-TXT (ENAME / EDATA RETVAL)
  (setq RETVAL '() ;_ Liste initialiseren
        EDATA  (entget ENAME)
  ) ;_ end setq
  (if (assoc 66 EDATA) ;_ GC 66 fehlt, wenn Block keine Attrib's hat
    (progn
      (while (/= (cdr (assoc 0 EDATA)) "SEQEND") ;_ Solange die Sequenz nicht endet...
        (setq EDATA (entget (entnext (cdr (assoc -1 EDATA)))))
        (if (= (cdr (assoc 0 EDATA)) "ATTRIB")
          (setq RETVAL
                 (cons
                   (cons (cdr (assoc 2 EDATA)) (cdr (assoc 1 EDATA)))
                   RETVAL
                 ) ;_ end cons
          ) ;_ end setq
        ) ;_ end if
      ) ;_ end while
      (setq RETVAL (reverse RETVAL))
    ) ;_ end progn
  ) ;_ end if
  RETVAL
) ;_ end defun