;;;
;;;bdfl -> Blockdefinition for load
;;;
;;;Schreibt die Blockdefinition als (entmake (list ... in eine Datei, das ermöglicht das einfügen von externen Blöcken
;;;mittels (load... Befehl.
;;;Der Block selbst kann dann mit dem (Insert-Befehl in der Zeichnung eingefügt werden.
;;;Die Blockdatei hat die Erweiterung *.blk
;;;
;;;Sind im Block mehrere Verschachtelungsebenen von Blöcken enthalten, werden die verschachtelten Blöcke ebenfalls erzeugt.
;;;Layer & Textstile die in dem Block benötigt werden,  sind in der BLK-Datei gespeichert und werden beim Laden mit erzeugt.
;;;
;;;
;;;Einschränkungen: 	Bemaßungen!
;;;			Bemaßungen werden in der BLK-Datei nicht gespeichert, da der Bemaßungsstil in der Zielzeichnung
;;;			existieren muß. Existiert dieser nicht, wird auch der Block nicht erzeugt
;;;
;;;
;;;AutoCAD-Release:	2000 (vermutlich auch auf- und abwärtskompatibel)
;;;
;;;Version:		1/0 - 22.05.2002
;;;
;;;Startaufruf:		bdfl
;;;
;;;benötigte Dateien:   blockdef_forLOAD.lsp
;;;
;;;
;;;Programmiert:	Holger Brischke
;;;			Metro Real Estate Management GmbH
;;;			DV-CAD
;;;			66121 Saarbrücken
;;;			Mainzer Str. 180-184
;;;			[0049]-(0)681/8104-2584
;;;			brischkh@mre.de
;;;			brischke@planet-interkom.de
;;;
;;;
(defun c:bdfl (/ bdfl_el *bdfl_eli* *bdfl_lali* *bdfl_stli* bdfl_fdesc bdfl_tyn)
  (setq bdfl_el (car (entsel "\nBlock wählen:")))
  (if (f:bdfl_typ bdfl_el)
    (f:bdfl_rotblk bdfl_el)
    )
  (setq bdfl_fdesc (open (getfiled "Blockdatei" "c:/temp/" "blk" 1) "W"))
  (initget "Ja Nein")
  (mapcar '(lambda (ST)
	     (f:bdef_write
	       (list (entget (tblobjname "STYLE" ST)))
	       bdfl_fdesc
	       nil
	       )
	     )
	  *bdfl_stli*
	  )
  (mapcar '(lambda (LA)
	     (f:bdef_write
	       (list (entget (tblobjname "LAYER" LA)))
	       bdfl_fdesc
	       nil
	       )
	     )
	  *bdfl_lali*
	  )
  (mapcar '(lambda (bdfl_blkli)
	     (f:bdef_write
	       (append
		 (list(tblsearch "BLOCK" (cdr (assoc 2 (entget (cadr bdfl_blkli))))))
		 (mapcar 'entget (car bdfl_blkli))
		 );append
	       bdfl_fdesc
	       T
	       );blockdef_write
	     )
	  *bdfl_eli*
	  )
  (if bdfl_fdesc (close bdfl_fdesc))
  )
;;;
;;;
(defun f:bdfl_typ (bdfl_telem / )
  (= "INSERT" (cdr (assoc 0 (entget bdfl_telem))))
  )
;;;
;;;
(defun f:bdfl_rotblk (bdfl_belem / )
  (mapcar '(lambda (X)
	     (if (f:bdfl_typ X)
	       (f:bdfl_rotblk X)
	       )
	     )
	  (if (setq bdfl_elom (f:bdfl_elem-of-b bdfl_belem))
	    (caar (setq *bdfl_eli* (cons (list bdfl_elom bdfl_belem) *bdfl_eli*)))
	    )
	  )
  )
;;;
;;;
(defun f:bdfl_elem-of-b (bdfl_eob_blk / bdfl_eob_elem bdfl_eob_elemlist bdfl_eob_bnam bdfl_eob_benam)
  (setq bdfl_eob_elem (cdr(assoc -2 (tblsearch "BLOCK" (setq bdfl_eob_bnam (cdr (assoc 2 (entget bdfl_eob_blk))))))))
  (if (not (or
	     (= "AVE_RENDER" bdfl_eob_bnam)
	     (= "AVE_GLOBAL" bdfl_eob_bnam)
	     )
	   )
    (while bdfl_eob_elem
      (if (not
	    (or
	      (member (cdr (assoc 0 (entget bdfl_eob_elem))) '("DIMENSION" "ENDBLK"))
	      (= "AVE_RENDER" (setq bdfl_eob_benam(cdr (assoc 2 (entget bdfl_eob_elem)))))
	      (= "AVE_GLOBAL" bdfl_eob_benam)
	      )
	    )
	(progn
	  (if (and
		(assoc 7 (entget bdfl_eob_elem))
		(not (member (setq bdfl_eob_la (cdr (assoc 7 (entget bdfl_eob_elem)))) *bdfl_stli*))
		)
	    (setq *bdfl_stli* (cons bdfl_eob_la *bdfl_stli*))
	    )
	  (if (not (member (setq bdfl_eob_la (cdr (assoc 8 (entget bdfl_eob_elem)))) *bdfl_lali*))
	    (setq *bdfl_lali* (cons bdfl_eob_la *bdfl_lali*))
	    )
	  (setq bdfl_eob_elemlist (cons bdfl_eob_elem bdfl_eob_elemlist))
	  )
	)
      (setq bdfl_eob_elem (entnext bdfl_eob_elem))
      )
    )
  bdfl_eob_elemlist
  )
;;;
;;;
(defun f:bdef_write (bdfl_bdw_blkliste bdfl_bdw_f bdfl_endBLK /)
  (mapcar '(lambda (E)
	     (princ "(entmake (list" bdfl_bdw_f)
	     (write-line "" bdfl_bdw_f)
	     (mapcar '(lambda (X)
			(if (not(member (car X) '( -2 -1 330 5 390 370)))
			  (progn
			    (cond
			      ((and
				 (= (car X) 6)
				 (= (strcase(cdr X)) "AUSGEZOGEN")
				 )
			       (setq X (cons 6 "CONTINUOUS"))
			       )
			      ((or
				 (= (car X) 71)
				 (= (car X) 97)
				 )
			       (setq X (cons (car X) 0))
			       )
			      )
			    (princ "'" bdfl_bdw_f)
			    (princ (if (= 'STR (type (cdr X)))
				     (cons (car X) (strcat "\"" (if
								  (= 1 (car X))
								  (f:bdfl_chstr (cdr X))
								  (cdr X)
								  )
							   "\""))
				     X
				     )
				   bdfl_bdw_f)
			    (write-line "" bdfl_bdw_f)
			    )
			  )
			)
		     E
		     )
	     (princ "))" bdfl_bdw_f)
	     (write-line "" bdfl_bdw_f)
	     )
	  bdfl_bdw_blkliste
	  )
  (if bdfl_endBLK
    (write-line "(setq nblk (entmake (list '(0 . \"endblk\"))))(princ (strcat \"Block \"(if nblk nblk \"NOT\")\" Made\"))(setq nblk nil)" bdfl_bdw_f)
    )
  )
;;;
;;;
;;;
(defun f:bdfl_chstr (bdfl_cs / bdfl_cs_li bdfl_cs_z)
  (setq bdfl_cs_z 0)
  (apply 'strcat (reverse(while (< bdfl_cs_z (strlen bdfl_cs))
		   (setq bdfl_cs_z (1+ bdfl_cs_z)
			 bdfl_cs_1 (substr bdfl_cs bdfl_cs_z 1)
			 bdfl_cs_li (cons
				      (if (= "\"" bdfl_cs_1)
					(setq bdfl_cs_1 (strcat "\\" bdfl_cs_1))
					bdfl_cs_1
					)
				      bdfl_cs_li
				      )
			 )
		   ))
	 )
  )
;;;
;;;
;;;
(princ "\nHolger Brischke ->brischke@planet-interkom.de")
(princ "\nBDFL geladen! ->\"bdfl\"")
(princ)