Files

45 lines
3.2 KiB
Common Lisp

(DEFUN C:GTEXT ()
(COMMAND "_TEXT")
)
(defun searc (S t / l g i o)(SETQ l (STRLEN t) g (STRLEN S) i 1 o nil)
(WHILE (<= i l)
(IF (= (SUBSTR t i g) S)(SETQ l (- i 1) o T)(SETQ i (+ i 1))))
(IF (= o nil)(SETQ i 0))(FIX i))
(defun C:SICH ( / )
(if (NOT (equal g_si 0.0 0.001))
(if (> (- (getvar "tdindwg") g_si2) (/ g_si 1440.0) )
(progn
(setq g_si2 (getvar "tdindwg"))
(prompt " Saving drawing !")
(command "_SAVE" "")
)
)
)
(princ)
)
(defun g_in (d pr st / S d0 p0 p o2 ot)
(setq d0 d d (cond ((= d nil) st)
((AND (= (type d) 'REAL)(= (type st) 'INT))(fix d)) ((AND (= (type st) 'REAL)(= (type d) 'INT))(float d)) ((/= (type st)(type d)) st) (d)))(setq S
(cond ((= (type d) 'REAL) (getreal (strcat pr "<" (rtos d 2 3) "> "))) ((= (type d) 'INT) (getint (strcat pr "<" (itoa d) "> "))) ((= (type d) 'STR)
(getstring T (strcat pr "<" d "> "))) ((= (type d) 'LIST) (progn (setq o2 (getvar "osmode")) (if (/= (nth 3 st) nil)(progn (setq ot (nth 4 st))
(setvar "osmode" (nth 3 st)))(setq ot "")) (setq p (if (= d0 nil) (getpoint (strcat pr " (Return=Ref.punkt)" "<" ot "> "))
(getpoint d (strcat pr " (Return=Ref.punkt)" "<" ot "> ")) )) (if (= p nil) (setq p0 (getpoint (strcat "\n" "Referenzpunkt:" " "))
p (getpoint p0 (strcat "\n" "Relativpunkt:" " ")))) (if (= p nil)(quit)) (setvar "osmode" o2) (setq p p) ))))(cond ((or (null S)(= S ""))(setq s d))
(S S) ))(defun g_ky (d pr st key / S p0 p)(initget key)(if (= d nil)(setq d st))(setq S (getkword (strcat pr " <" d "> ")))(cond
((or (null S)(= S ""))(setq s d)) (S S) ))(defun g_se ()(setvar "cmdecho" 0)(setvar "blipmode" 0)(SETVAR "OSMODE" 0)(setvar "orthomode" 0)
(setvar "snapmode" 0)(setvar "limcheck" 0)(setq *error* g_er))(defun g_sv ()(setvar "cmdecho" 0)(setq blip (getvar "blipmode"))
(SETQ OSMO (GETVAR "OSMODE"))(setq orth (getvar "orthomode"))(setq snap (getvar "snapmode"))(setq olay (getvar "clayer"))
(setq g_lim (getvar "limcheck"))(setq *error* g_er))(defun g_un ()(setvar "blipmode" blip)(SETVAR "OSMODE" osmo)(setvar "snapmode" snap)
(setvar "orthomode" orth)(setvar "limcheck" g_lim)(command "LAYER" "SETZ" olay ""))(defun g_ru ()(setvar "blipmode" blip)(SETVAR "OSMODE" osmo)
(setvar "snapmode" snap)(setvar "orthomode" orth)(setvar "limcheck" g_lim))(defun C:g-krz ( / p1 r c )(g_sv)
(setq p1 (g_in nil "\nMittelpunkt:" (list 0 0 0 4 "ZEN")) r (getdist p1 "\nRadius:" ) c (getvar "clayer"))
(if (< r (* 20. g_f))(command "LAYER" "SETZ" (nth 10 v-lay) "") (command "LAYER" "SETZ" (nth 7 v-lay) ""))(command "LINIE" p1 (polar p1 0 r) ""
"LINIE" p1 (polar p1 (* pi 0.5) r) "" "LINIE" p1 (polar p1 pi r) "" "LINIE" p1 (polar p1 (* pi 1.5) r) "" "LAYER" "SETZ" c "")(princ))
(defun C:g-sax ( / p1 p2 c r )(g_sv)
(setq p1 (g_in nil "\nStartpoint of Middleline:" (list 0 0 ))
p2 (g_in p1 "\nEndpoint of Middleline:" (list 0 0 )) c (getvar "clayer") r (distance p1 p2))
(if (< r (* 40 g_f))(command "_LAYER" "_SET" (nth 10 v-lay) "") (command "_LAYER" "_SET" (nth 7 v-lay) ""))
(command "_LINE" (polar p1 (angle p2 p1) 5.) (polar p2 (angle p1 p2) 5.) "" "_LAYER" "_SET" c ""))(defun g_er (st)(if (and (/= st "")
(/= st "quit / exit abort")) (prompt (strcat "\nError : " st)) (prompt "!!"))(g_un)(if (/= datnr nil)(progn(close datnr)(setq datnr nil)))
(setq *error* ())(princ))(setq stopit g_er)(princ)