41 lines
5.0 KiB
Common Lisp
41 lines
5.0 KiB
Common Lisp
(prompt "\nFunktionen DINA laden ........... ")(setvar "cmdecho" 0)(prompt ".")(defun sym (p0 p1 d1 fa sy / ag ce d2 e1)
|
|
(if (= sy t)(setq g-sym (strcase(g_in g-sym "\nMittellinie zeichnen ? (Ja=J/nein=N):" "J")))(setq g-sym "J"))(if (= g-sym "J")(progn
|
|
(setq ag (angle p0 p1) ce (getvar "clayer"))(if (< (distance p0 p1) (* 20 g_f))(setq la (nth 10 v-lay))(setq la (nth 7 v-lay)))(cond((= fa "A")(progn
|
|
(command "_LINE" (polar p0 (+ ag pi) d1) (polar p1 ag d1) "")(setq e1 (entget (entlast)))(entmod (subst (cons 8 la)(assoc 8 e1) e1))))
|
|
((= fa "B")(progn(setq d2 (* d1 1.2))(command "_LINE" (polar p0 0 d2) (polar p0 pi d2) "")(setq e1 (entget (entlast)))
|
|
(entmod (subst (cons 8 la)(assoc 8 e1) e1))(command "_LINE" (polar p0 (* pi 0.5) d2) (polar p0 (* pi 1.5) d2) "")(setq e1 (entget (entlast)))
|
|
(entmod (subst (cons 8 la)(assoc 8 e1) e1))))))))(prompt ".")(defun les (vz zi dt fa gr / ls fs )(setvar "cmdecho" 0)(gc)(setq ls nil fs fa)(cond
|
|
((= fa "A")(progn (if (= (type soll) 'str)(if (/= (substr soll 1 1) "M")(setq soll "M10")))
|
|
(setq soll (g_in soll "\nDurchmesser (M1.6 .. M30) ?" "M10") )))((= fa "C")(setq fs "A"))((= fa "D")(setq fs "B")))
|
|
(setq du (strcat pfad "dinsuche " fs " " pfad dt " " (rtos vz 2 0) " " (rtos zi 2 0) " " soll " "))(command "SH" du)(if (= gr t)(command "_GRAPHBLD"))
|
|
(if (/= fa "D")(progn(setq datnr (open "temp.$$$" "r"))(if (/= datnr nil)(progn(if (= vz 6)(progn (setq tex nil)
|
|
(repeat 6 (setq tex (cons (read-line datnr) tex))) (setq tex (reverse tex) txx (nth 0 tex)))(setq txx (read-line datnr)))(if (/= txx "nil")(progn
|
|
(setq a (read-line datnr)) (while (/= a nil) (setq ls (cons a ls)) (setq a (read-line datnr)) ) (setq ls (reverse ls))(close datnr)(setq datnr nil))
|
|
(setq ls nil datnr nil))) (if (/= fa "b")(prompt "\nError: keine DIN-Vorgabe !")) )))(setq ls ls))(prompt ".")
|
|
(defun g-b2 (pp fe le e0 / s1 du ct el pm r p3 ez la)(setq s1 nil du nil s1 (ssget "K" (polar pp (* pi 0.25) le)(polar pp (* pi 1.25) le)))
|
|
(if (= s1 nil)(prompt "\nError: kein Objekt gefunden")(progn(if (/= e0 nil)(setq s1 (ssdel e0 s1)))(setq ct 0)(while (/= nil (ssname s1 ct))
|
|
(setq el (ssname s1 ct) ct (1+ ct))(cond ((= (cdr (assoc 0 (entget el))) "INSERT")(prompt "Error: Block nicht brechbar "))
|
|
((= (cdr (assoc 0 (entget el))) "CIRCLE") (progn (setq pm (trans (cdr (assoc 10 (entget el))) 0 1) r (cdr (assoc 40 (entget el)))
|
|
p3 (polar pm (angle pp pm) (* r 2))) (command "_BREAK" el pp p3 "_MIRROR" el "" pp p3 "N")
|
|
(if (and (= fe nil)(= du nil))(progn(prompt "\nKontur gebrochen !")(setq du t)))))((= (cdr (assoc 0 (entget el))) "POLYLINE") (progn
|
|
(if (< (distance (trans (cdr (assoc 10 (entget (entnext el)))) 0 1) pp) 1.0e-10)() (progn (setq ez el)
|
|
(while (= (cdr (assoc 0 (entget (entnext ez)))) "VERTEX") (setq ez (entnext ez)) ) (if (< (distance (trans (cdr (assoc 10 (entget ez))) 0 1) pp)
|
|
1.0e-10)() (progn (command "_BREAK" el pp pp) (if (and (= fe nil)(= du nil))(progn (prompt "\nKontur gebrochen !")(setq du t))) )) ))))(progn
|
|
(command "_BREAK" el pp pp) (if (and (= fe nil)(= du nil))(progn(prompt "\nKontur gebrochen !")(setq du t)))))
|
|
(if (= fe t) (prompt (strcat " " (itoa ct) " ")))) )) (setq s1 nil))(prompt ".")(defun ZIEH (to en / tx p0 p1 ps e2 cx he br h2 b2)
|
|
(setq tx to cx "TEXT")(setvar "cmdecho" 0)(if (= en T)(g_sv))(cond ((and (= en 0)(= g_if 0))(setq en 0)) ((and (= en 0)(= g_if 1))(setq en 1))
|
|
((and (= en 0)(= g_if 2))(setq en 2)))(if (/= g_if 2)(progn (setq e2 3) (if (= tx "")(setq tx "0"))
|
|
(setq he (* 5.0 g_f) br he b2 (* 2 br) h2 (* he 0.5))(while (or(= e2 3)(= e2 4))(progn(if (= en 0)(progn (setvar "attdia" 0)
|
|
(setq p1 (getpoint "\nPosition Infopunkt:")) (if (/= p1 nil)(command "_insert" "dininfo" p1 g_f g_f 0 (nth 0 tx) (nth 1 tx) (nth 2 tx) (nth 3 tx)
|
|
(nth 4 tx) (nth 5 tx) ))(setvar "attdia" 1)) (progn (setq p1 (getpoint "\n<Startpunkt>,(Return=Ende):") p2 nil)
|
|
(if (/= p1 nil)(setq p2 (getpoint p1 "\nLinienendpunkt:"))) (if (and (or (= en 3)(= en 4))(= p2 nil)) (quit)) (if (/= p2 nil)
|
|
(command "_PLINE" (polar p1 (angle p1 p2) (* 0.5 g_f)) "K" "RA" (* 0.5 g_f) "W" "359" (* 57.32 (- (angle p1 p2) (* pi 0.5))) "L" p2 "" (terpri)
|
|
"_change" "_L" "" "_LA" (nth 5 v-lay)) ))) (if (= en 1)(setq tx (strcat (nth 0 to) " " (nth 2 to))))(if (= en 4) (progn
|
|
(setq he (* 5.0 g_f) br he b2 (* 2 br) h2 (* he 0.5) cx "DTEXT" tx nil) (prompt "\nDText (Return=neue Zeile):")))(if (or (= en 1)(= en 4)) (progn
|
|
(setq ag (angle p1 p2)) (g-zi1 cx p2 ag he tx)))(setq e2 en)))))(princ))(defun g-zi1 (cx p2 ag he tx / la h2 br p4)
|
|
(setq p4 (* pi 0.25) la (getvar "clayer") h2 (* he 0.5) br he) (command "_LAYER" "_SET" (nth 4 v-lay) "") (cond
|
|
((or (>= ag (* p4 7)) (< ag p4))(command cx (list (+ (car p2) br)(- (cadr p2) h2)) he 0 tx))
|
|
((and (>= ag p4) (< ag (* p4 3)))(command cx "M" (list (car p2)(+ (cadr p2) he)) he 0 tx))
|
|
((and (>= ag (* p4 3)) (< ag (* p4 5)))(command cx "R" (list (- (car p2) br)(- (cadr p2) h2)) he 0 tx))
|
|
((and (>= ag (* p4 5)) (< ag (* p4 7)))(command cx "M" (list (car p2)(- (cadr p2) (* h2 2.5))) he 0 tx)) ) (command "_LAYER" "_SET" la ""))(princ)
|
|
|