(defun C:Wel(/ falt lalt B H1 D1 M H2 p1 p2 p3 p4 p5 p6 p65
             p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18
             p185 p19 p20 p21 p22 p23 xB xH1 xD1 xM xH2)
  (setq falt( Getvar "osmode")
        lalt( Getvar "clayer")
        )
  (setvar "osmode" 0)
; Alu-Platte
  (initget (+ 1 2 4))
  (setq B (getreal "\nBreite: "))
  (initget (+ 1 2 4))
  (setq H1 (getreal "\nHöhe: "))
  (initget (+ 1 2 4))
  (setq D1 (Getreal"\nDurchmesser:"))
  (initget (+ 1 2 4))
  (setq M (Getreal "\nMitte:"))
  (setq H2 (- H1 M)) ; Höhe minus Mitte
; Anfangspunkt
  (setq p1 (list 200 200 )
        ; Koordinaten Rechteck
        p2 (polar p1 (* pi 2) (/ B 2)) ;  X Koordinaten
        p3 (polar p1 (* pi 2) B)
        p4 (polar p3 (/ pi 2) M)
        p5 (polar p3 (/ pi 2) H1)
        p6 (polar p5 pi B)
        ; Löcher Koordinaten
        p65 (polar p1 (/ pi 2) 20)
        p7(polar p65 (* pi 2) 20)
        p8 (polar p7 (* pi 2) (- B 40))
        p9 (polar p8 (/ pi 2) (- H1 40))
        p10(polar p9 pi (- B 40))
        p11(polar P2 (/ pi 2) M)
        ; Bemaßungs Koordinaten
        p12(polar p11 pi (/ D1 2))
        p13(polar p11 (* pi 2) (/ D1 2))
        p14(polar p1 (* (/ pi 2) 3) 150)
        p15(polar p3 (* pi 2) 70)
        p16(polar p1 pi 150)
        p17(polar p7 (* (/ pi 2) 3) 90)
        p18(polar p10 pi 100)
        ; Text Koordinaten
        p185(polar p6 pi 120)
        p19 (polar p185(/ pi 2) 100)
        p20 (polar p19 (* pi 2) 90)
        p21 (polar p20 (* pi 2) 115)
        p22 (polar p21 (* pi 2) 110)
        p23 (polar p22 (* pi 2) 115)
        )
  (ltb_akt "KONTUR" "CONTINUOUS" 7 1 nil)
  (create:line p1 p2 (getvar "CLAYER") 256)
  (create:line p2 p3 (getvar "CLAYER") 256)
  (create:line p3 p4 (getvar "CLAYER") 256)
  (create:line p4 p5 (getvar "CLAYER") 256)
  (create:line p5 p6 (getvar "CLAYER") 256)
  (create:line p6 p1 (getvar "CLAYER") 256)
  ;(Command "Linie" p1 p2 p3 p4 p5 p6 p1"") ; zeichnet das Rechteck von Punkt nach Punkt
  
  (foreach P (list p7 p8 p9 p10)
    (create:circle P 8.0 (getvar "CLAYER") 256)
    )
  (create:circle p11 (/ D1 2.0) (getvar "CLAYER") 256)
;;;  (Command "Kreis" p7 "D" 16 ; zeichnet Kreis u L
;;;           "Kreis" p8 "D" 16 ; zeichnet Kreis u R
;;;           "Kreis" p9 "D" 16 ; zeichnet Kreis o L
;;;           "Kreis" p10"D" 16 ; zeichnet Kreis o R
;;;           "Kreis" p11"D" D1 ; zeichnet mittleren Durchmesser
;;;           )
  (ltb_akt "Bemaßung" "CONTINUOUS" 3 1 nil)
  ;;;(Command "Layer" "se" "Bemaßung" "")
  (create:DIM p13 p12 M "H" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p1 p3 M "H" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p7 p8 M "H" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p7 p10 (* M 2.0) "V" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p3 p4 (* M -1) "V" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p4 p5 (* M -1) "V" "Bemaßung"  256 (getvar "DIMSTYLE"))
  (create:DIM p1 p6 (* M 2.0) "V" "Bemaßung"  256 (getvar "DIMSTYLE"))
;;;  (Command "Bem1" "hor" p13 p12 p11 ""
;;;           "Bem1" "hor" p1 p3 p14 ""
;;;           "Bem1" "hor" p7 p8 p17 ""
;;;           "Bem1" "ver" p7 p10 p18 ""
;;;           "Bem1" "ver" p3 p4 p15 ""
;;;           "Bem1" "ver" p4 p5 p15 ""
;;;           "Bem1" "ver" p1 p6 p16 ""
;;;           )
  ; Umwandeln von einer realen, in eine ganze Zahl
  (Setq  xB (fix B)
         xH1(fix H1)
         xD1(fix D1)
         xM (fix M)
         xH2(fix H2)
         )
  (ltb_akt "TEXT" "CONTINUOUS" 2 1 nil)
  ;;;(Command "layer" "se" "Text" "")
  ;(create:text txt txh pkt lay col stil)
  (create:text xB 30.0 p19 "TEXT" 256 "Standard")
  ;(Command "text" p19 "30" "" xB "")
  (create:text (- xH1) 30.0 p20 "TEXT" 256 "Standard")
  ;(Command "text" p20 "30" "" (- xH1) "")
  (create:text (- xD1) 30.0 p21 "TEXT" 256 "Standard")
  ;(Command "text" p21 "30" "" (- xD1) "")
  (create:text (- xM) 30.0 p22 "TEXT" 256 "Standard")
  ;(Command "text" p22 "30" "" (- xM) "")
  (create:text (- xH2) 30.0 p23 "TEXT" 256 "Standard")
  ;(Command "text" p23 "30" "" (- xH2) "")
  (Command "Zoom" "g")
  ;;;
  (setvar "CLAYER" lalt)
  (setvar "OSMODE" falt)
  ) ;Ende
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Baustein : LAYER
;;;
;;;
;;;
;;;AutoCAD-Release:	R2000
;;;			(vermutlich auch abwärts- und aufwärts- kompatibel)
;;;
;;;Version:		1/1-15.03.2000
;;;
;;;Hinweis:		Freeware -- Freeware -- Freeware
;;;			Verwies auf Urheber versteht sich von selbst!
;;;
;;;Startaufruf:		%
;;;
;;;benötigte Dateien:   ltb.lsp (Programm)
;;;
;;;Einschränkungen:	% (nicht bekannt)
;;;
;;;Programmiert:	Holger Brischke
;;;			(defun - Lisp over night!
;;;			http://www.defun.de
;;;			Tel: +49(0)681/989 06 84
;;;			mobil: +49(0)175/205 88 77
;;;			mailto:kontakt@defun.de
;;;
;;;Installation:	%
;;;
;;;SUB-Beschreibung
;;;
;;;Folgende Bausteine sind hierin enthalten:
;;;			LAYER...
;;;	ltb_akt	->.. aktuell setzen / bei Bedarf erzeugen
;;;	ltb_on	->.. einschalten
;;;	ltb_off	->.. ausschalten
;;;	ltb_tau	->.. tauen
;;;	ltb_frz	->.. frieren
;;;	ltb_unl	->.. entsperren
;;;	ltb_log	->.. sperren
;;;	---------------------------
;;;	ltb_sub_make	-> erzeugt Layer in Layertabelle
;;;
;;;
;;;
;;;Über Hinweise Anregungen und auch Kritik würde ich mich freuen.
;;;
;;;Holger Brischke
;;;kontakt@defun.de

;;;
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------EINSCHALTEN-----
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht angeschaltet (war an oder Layer gibt es nicht)
;;;		T   ->	angeschaltet
(defun ltb_on (ltb_name / ltb_layer ltb_do ltb_laycol)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (> 0 (cdr(assoc 62 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))))
	(progn
	  (setq ltb_laycol (cons 62 (* -1 (cdr(assoc 62 ltb_layer))))
		ltb_layer (subst ltb_laycol (assoc 62 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------AUSSCHALTEN-----
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht ausgeschaltet (war aus oder Layer gibt es nicht)
;;;		T   ->	ausgeschaltet
(defun ltb_off (ltb_name / ltb_layer ltb_do ltb_laycol)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (< 0 (cdr(assoc 62 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))))
	(progn
	  (setq ltb_laycol (cons 62 (* -1 (cdr(assoc 62 ltb_layer))))
		ltb_layer (subst ltb_laycol (assoc 62 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------TAUEN-----------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht getaut (war getaut oder Layer gibt es nicht)
;;;		T   ->	getaut
(defun ltb_tau (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 1 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 1))
	(progn
	  (setq ltb_bit70 (cons 70 (1- (cdr(assoc 70 ltb_layer))))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------FRIEREN---------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht gefroren (war getaut oder Layer gibt es nicht oder Layer ist aktuell)
;;;		T   ->	gefroren
(defun ltb_frz (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (and
	(tblsearch "LAYER" ltb_name)
	(not (= ltb_name (getvar "CLAYER")))
	);and
    (progn
      (if (= 0 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 1))
	(progn
	  (setq ltb_bit70 (cons 70 (1+ (cdr(assoc 70 ltb_layer))))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------ENTSPERREN------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht entsperrt (war nicht gesperrt oder Layer gibt es nicht)
;;;		T   ->	entsperrt
(defun ltb_unl (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 4 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 4))
	(progn
	  (setq ltb_bit70 (cons 70 (- (cdr(assoc 70 ltb_layer)) 4))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------SPERREN---------
;;;########################################################################################################
;;;Rückgabe 	nil -> 	nicht entsperrt (war nicht gesperrt oder Layer gibt es nicht)
;;;		T   ->	entsperrt
(defun ltb_log (ltb_name / ltb_bit70 ltb_layer ltb_do)
  (if (tblsearch "LAYER" ltb_name)
    (progn
      (if (= 0 (logand (cdr(assoc 70 (setq ltb_layer (entget (tblobjname "LAYER" ltb_name))))) 4))
	(progn
	  (setq ltb_bit70 (cons 70 (+ (cdr(assoc 70 ltb_layer)) 4))
		ltb_layer (subst ltb_bit70 (assoc 70 ltb_layer) ltb_layer)
		ltb_do T
		)
	  (entmod ltb_layer)
	  )
	)
      )
    )
  ltb_do
  )
;;;
;;;########################################################################################################
;;;Layer-----------------------------------------------------------------------------------AKTUELL---------
;;;########################################################################################################
;;;Neue Layer aktuell setzen oder erzeugen
;;;Übergabewerte müssen sein Lay-Name,-Linientyp,-Farbe, Drucken JA/NEIN Linientypdatei
;;;			   Stirng  String  Int	Int(1/0) String
;;;verwendete SUB's	(ltb_sub_make)	Erzeugt Layer in Zeichnungsdatenbank
;;;
;;;Der aktuelle zu setzende Layer wird entweder erzeugt oder eingeschaltet/getaut/entsperrt und aktuell gesetzt
;;;Linientypen werden, wenn sie nicht geladen werden entweder aus der acadiso oder aus einer anzugebenden Linientypdatei geladen
;;;
;;;Beispielaufruf:	(ltb_akt "MEINLAYER" "CONTINUOUS" 3 0 nil) ;;;Linientyp wird aus der acadiso genommen, wenn dieser nicht schon vorhanden ist
;;;			(ltb_akt "MEINLAYER" "CONTINUOUS" 3 0 "MEINELTYPEN");;;Linientyp wird aus der meineltypen genommen, wenn dieser nicht schon vorhanden ist
;;;
;;;
;;;
(defun ltb_akt (ltb_name ltb_ltyp ltb_laycol ltb_prn ltb_file_ltyp / 
		 ltb_olay ltb_vor ltb_ltvor
		 ltb_laycol ltb_name)
  (if (not ltb_file_ltyp)
    (setq ltb_file_ltyp "acadiso")
    )
  (setq ltb_olay (getvar "clayer")
	ltb_vor (tblsearch "LAYER" ltb_name);Ist Layer vorhanden?
	ltb_ltvor (tblsearch "LTYPE" ltb_ltyp)
	)
  (if (= ltb_ltvor nil);Wenn Linientyp nicht gefunden wird, dann wird Linientyp geladen aus ACADISO.LIN
    (progn
      (setvar "filedia" 0)
      (command "_.linetype" "_l" ltb_ltyp ltb_file_ltyp "")
      (setvar "filedia" 1)
      )
    )
  (if (tblsearch "LTYPE" ltb_ltyp)
    (progn
      (if (= ltb_vor nil);wenn der Layer nicht vorhanden ist,...
	(ltb_sub_make ltb_name ltb_ltyp ltb_laycol ltb_prn);Aufruf SUB (laymak) ;(Name LTyp Farbe dru_jn)
	(setq;wenn LAyer bereits vorhanden
	  ltb_von (ltb_on ltb_name);EINSCHALTEN
	  ltb_vtau (ltb_tau ltb_name);TAUAN
	  ltb_vunl (ltb_unl ltb_name);ENTSPERREN
	  )
	);if
      (if ltb_vtau (command "_.regen"));nach dem Tauen ist ein regenerieren notwendig
      (princ)
      (setvar "clayer" ltb_name)
      (princ "\naktueller Layer: ")
      (princ ltb_name)
      )
      (princ "\nLinientyp/Linientypdatei nicht gefunden! Keinen Layer erzeugt!")    
    )  
  (princ)
)
;;;
;;;////////////////////////////////////////////////////////////////////////////////////////////////////////
;;;Layer--------------------------------------------------------------------------SUB------ERZEUGEN--------
;;;////////////////////////////////////////////////////////////////////////////////////////////////////////
;;;Neue Layer aktuell erzeugen
;;;AutoCAD-Version unabhängig
(defun ltb_sub_make (ltbs_name ltbs_ltyp ltbs_color ltbs_prn / )
  (entmake
    (if (< 14 (atoi(substr (getvar "acadver") 1 2)));AutoCAD-Version abfragen
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	(cons 2  ltbs_name)
	'(70 . 0)
	(cons 62  ltbs_color)
	(cons 6  ltbs_ltyp)
	(cons 290 ltbs_prn);ab R15 (2000) erst möglich
	'(370 . -3)
	)
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	(cons 2  ltbs_name)
	'(70 . 0)
	(cons 62  ltbs_color)
	(cons 6  ltbs_ltyp)
	'(370 . -3)
	)
      )
    )
  (princ)
  )
;;;
;;;
;;;
(princ "\nLTB geladen!\n(defun - Lisp over night\nHolger Brischke (kontakt@defun.de)")
(princ "\nVerwendung:")
(princ "\n(ltb_akt Layername Linientyp Farbnr DruckenJ/N alternative Linientypdatei)")
(princ "\n(ltb_akt \"MEINLAYER\" \"CONTINUOUS\" 3 0 \"MEINELTYPEN\")")
(princ "\n(ltb_akt \"MEINLAYER\" \"CONTINUOUS\" 3 0 nil)")
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun create:text (txt txh pkt lay col stil / )
  (entmake (list
             '(0 . "TEXT")
             '(100 . "AcDbEntity")
             '(67 . 0)
             '(410 . "Model")
             (cons 8 (if (and
                           lay
                           (tblobjname "LAYER" lay)
                           )
                       lay
                       (getvar "CLAYER")
                       )
                   )
             (cons 62 (if col
                        col
                        (cond
                          ((= "BYLAYER" (getvar "CECOLOR"))
                           256)
                          ((= "BYBLOCK" (getvar "CECOLOR"))
                           0)
                          (T (atoi(getvar "CECOLOR"))
                           )
                          )
                        )
                   )
             '(100 . "AcDbText")
             (cons 10 (if pkt
                        pkt
                        (getpoint "\nPunkt: ")
                        )
                   )
             (cons 40 (if (and
                            txh
                            (< 0.0 txh)
                            )
                        txh
                        (if (= 0.0 (setq txh (cdr(assoc 40(entget (tblobjname "STYLE"
                                                                    (if (and
                                                                          stil
                                                                          (tblobjname "STYLE" stil)
                                                                          )
                                                                      stil
                                                                      (getvar "TEXTSTYLE")
                                                                      )
                                                                    )
                                                                  )
                                                        )
                                                 )
                                         )
                               )
                          (progn
                            (initget 7)
                            (getreal "\nTexthöhe: ")
                            )
                          txh
                          )
                        )
                   )
             (cons 1 (if txt
                       (VL-PRINC-TO-STRING txt)
                       (getstring "\nText: ")
                       )
                   )
             '(50 . 0.0)
             '(41 . 1.0)
             '(51 . 0.0)
             (cons 7 (if (and
                           stil
                           (tblobjname "STYLE" stil)
                           )
                       stil
                       (getvar "TEXTSTYLE")
                       )
                   )
             '(71 . 0)
             '(72 . 0)
             '(11 0.0 0.0 0.0)
             '(210 0.0 0.0 1.0)
             '(100 . "AcDbText")
             '(73 . 0)
             )
           )
  )
(defun create:circle (pkt rad lay col / )
  (entmake (list
             '(0 . "CIRCLE")
             '(100 . "AcDbEntity")
             '(67 . 0)
             '(410 . "Model")
             (cons 8 lay)
             (cons 62 (if col
                        col
                        (cond
                          ((= "BYLAYER" (getvar "CECOLOR"))
                           256)
                          ((= "BYBLOCK" (getvar "CECOLOR"))
                           0)
                          (T (atoi(getvar "CECOLOR"))
                           )
                          )
                        )
                   )
             '(100 . "AcDbCircle")
             (cons 10 pkt)
             (cons 40 rad)
             '(210 0.0 0.0 1.0)
             )
           )
  )
(defun create:DIM (pt1 pt2 abst typ lay col stil / )
  (entmake (list
             '(0 . "DIMENSION")
             '(100 . "AcDbEntity")
             '(67 . 0)
             '(410 . "Model")
             (cons 8 lay)
             (cons 62 (if col
                        col
                        (cond
                          ((= "BYLAYER" (getvar "CECOLOR"))
                           256)
                          ((= "BYBLOCK" (getvar "CECOLOR"))
                           0)
                          (T (atoi(getvar "CECOLOR"))
                           )
                          )
                        )
                   )
             '(100 . "AcDbDimension")
             ;'(2 . "*D17")
             (cons 10
                   (if (= "H" (strcase typ))
                     (mapcar '- pt1 (list 0.0 abst 0.0))
                     (mapcar '- pt1 (list abst 0.0 0.0))
                     )
                   )
             (cons 11
                   (if (= "H" (strcase typ))
                     (mapcar '- pt2 (list 0.0 abst 0.0))
                     (mapcar '- pt2 (list abst 0.0 0.0))
                     )
                   )
             '(12 0.0 0.0 0.0)
             '(70 . 32)
             '(1 . "")
             '(71 . 5)
             '(72 . 1)
             '(41 . 1.0)
             '(42 . 60.0)
             '(52 . 0.0)
             '(53 . 0.0)
             '(54 . 0.0)
             '(51 . 0.0)
             '(210 0.0 0.0 1.0)
             (cons 3 (if (and
                           stil
                           (tblobjname "DIMSTYLE" stil)
                           )
                       stil
                       (getvar "DIMSTYLE")
                       )
                   )
             '(100 . "AcDbAlignedDimension")
             (cons 13 pt1)
             (cons 14 pt2)
             '(15 0.0 0.0 0.0)
             '(16 0.0 0.0 0.0)
             '(40 . 0.0)
             (cons 50 (if (= "H" (strcase typ))
                        0.0
                        (/ pi 2.0)
                        ))
             '(100 . "AcDbRotatedDimension")
             )
           )
  )
(defun create:line (p1 p2 lay col /)
  (entmake (list
             '(0 . "LINE")
             '(100 . "AcDbEntity")
             '(67 . 0)
             '(410 . "Model")
             (cons 8 lay)
             (cons 62 (if col
                        col
                        (cond
                          ((= "BYLAYER" (getvar "CECOLOR"))
                           256)
                          ((= "BYBLOCK" (getvar "CECOLOR"))
                           0)
                          (T (atoi(getvar "CECOLOR"))
                           )
                          )
                        )
                   )
             '(100 . "AcDbLine")
             (cons 10 p1)
             (cons 11 p2)
             '(210 0.0 0.0 1.0)
             )
           )
  )