Files

69 lines
8.9 KiB
Common Lisp

(prompt "\nLaden von Hilfslinien ........... ")(setq KPUL (trans (getvar "limmin") 0 1) KPOR (trans (getvar "limmax") 0 1))
(prompt ".")(defun C:g-GZ (/ E X A Z FRAG H)(g_sv)(g_se) (setq FRAG (getstring "\n(N)eue Grenzen/(S)creengrenzen ?")) (if (= (strcase FRAG) "N")
(progn (setq FP1 (trans (getpoint "\nGeben Sie Limitpunkt an: ") 1 0)) (setvar "limmin" (list (car FP1) (cadr FP1)) )
(setq FP2 (trans (getcorner FP1 "\nGeben Sie Limitpunkt an: ") 1 0)) (setvar "limmax" (list (car FP2) (cadr FP2)) ) ) ) (if (= (strcase FRAG) "S")
(progn (setvar "limmin" (trans (list (car (getvar "vsmin")) (cadr (getvar "vsmin"))) 0 1))
(setvar "limmax" (trans (list (car (getvar "vsmax")) (cadr (getvar "vsmax"))) 0 1)) ) ) (if (/= H 1) (progn
(setq A (ssget "X" (list (cons 8 "KLIN"))) X (sslength A) Z 0 ) (prompt "\n Hilfslinien werden neuen Grenzen angepasst ") (repeat X
(setq E (ssname A Z) Z (+ Z 1) ) (if (= "LINE" (cdr (assoc 0 (entget E)))) (progn (setq P1 (trans (cdr (assoc 10 (entget E))) 0 1)
P2 (trans (cdr (assoc 11 (entget E))) 0 1) ) (command "L™SCHEN" E "") (KIMV) (KIML P1 P2) (g_un) ) ) ) ) ) (g_un)(prin1))(prompt ".")
(defun C:g-HDA (/ A) (setq A (ssget "X" (list (cons 8 "KLIN")))) (command "L™SCHEN" A "") (redraw)(prin1))(prompt ".")
(defun C:g-HDW (/ A B D Z X V E)(g_sv)(g_se) (setq B (ssget "K" (setq D (getpoint "\nErster Eckpunkt Fangfenster: "))
(getcorner D "\nZweiter Eckpunkt Fangfenster: ")) A (ssget "X" (list (cons 8 "KLIN"))) Z 0 X (sslength B) V (ssadd) ) (if (/= X NIL) (progn (repeat X
(setq E (ssname B Z) Z (+ Z 1) ) (if (and (ssmemb E A) (ssmemb E B)) (ssadd E V)) ) (command "L™SCHEN" V "") ) )(g_un)(prin1)) (prompt ".")
(prompt ".")(defun KIML (P1 P2 / PUL PUR POL POR G L P1L P2L S S1) (g_se) (setq PUL (getvar "limmin") POR (getvar "limmax")
PUR (list (car POR) (cadr PUL)) POL (list (car PUL) (cadr POR)) PUL (trans pul 0 1) POR (trans por 0 1) PUR (trans pur 0 1) POL (trans pol 0 1)
G (list (list PUL PUR) (list PUR POR) (list POR POL) (list POL PUL)) L (* (distance PUL POR) 100) P1L (polar P1 (angle P1 P2) L)
P2L (polar P2 (+ (angle P1 P2) PI) L) S NIL ) (while G (setq S1 (inters P1L P2L (car (car G)) (cadr (car G)))) (if (/= S1 NIL) (setq S (cons S1 S))
) (setq G (cdr G)) ) (command "LINIE" (car S) (cadr S) ""))(defun KIMV () (g_sv) (command "LAYER" "SETZ" "KLIN" ""))(defun C:g-HB ()(KIMV)
(setq P1 (getpoint "\nErster Punkt angeben: ") P2 (getpoint P1 "\nZweiter Punkt angeben: ") ) (KIML P1 P2 )(g_un)(prin1))(DEFUN C:g-HH ()(KIMV)
(setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") P2 (polar P1 PI 5) ) (KIML P1 P2)(g_un)(prin1))(DEFUN C:g-hk ()(KIMV)
(setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") P2 (polar P1 PI 5)) (KIML P1 P2) (setq P2 (polar P1 (/ PI 2) 5)) (KIML P1 P2)
(g_un)(prin1))(DEFUN C:g-HV ()(KIMV) (setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") P2 (polar P1 (/ PI 2) 5) ) (KIML P1 P2)
(g_un)(prin1))(prompt ".")(defun C:g-HP (/ E LP1 LP2) (KIMV) (setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ")
E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END") LP2 (osnap (cadr E) "NAE") P2 (polar P1 (angle LP1 LP2) 10) ) (KIML P1 P2)(g_un)(prin1))
(defun C:g-HW (/ RAD1 RAD2 RAD3 E U)(KIMV) (setq E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END") LP2 (osnap (cadr E) "NAE")
P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") U (- (car LP1) (car LP2)) ) (if (= U 0) (setq RAD3 (/ PI 2)) (progn
(setq RAD1 (atan (/ (- (cadr LP1) (cadr LP2)) U)) RAD3 (abs RAD1) ) (if (< RAD1 0) (setq RAD3 (- PI RAD3))) ) )
(setq RAD2 (getangle "\nWinkel angeben: ") P2 (polar P1 (+ RAD3 RAD2) 10) ) (KIML P1 P2)(g_un)(prin1))(defun C:g-HS ( / E)(KIMV)
(setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END")
LP2 (osnap (cadr E) "NAE") P2 (polar P1 (+ (angle LP1 LP2) (/ PI 2)) 10) ) (KIML P1 P2)(g_un)(prin1))(defun C:g-HA (/ W)(KIMV)
(setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ") W (getangle P1 "\nWinkel angeben: ") P2 (polar P1 W 100) ) (KIML P1 P2 )(g_un)
(prin1))(prompt ".")(defun C:g-HD (/ E A1 W WE WX W1)(KIMV) (if (= ab nil)(setq ab 1)) (setq A1 (getdist (strcat "\nAbstand eingeben <"
(rtos ab 2 3) ">: "))) (if (/= A1 NIL) (setq AB A1)) (setq E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END") LP2 (osnap (cadr E) "NAE")
W (angle LP1 LP2) WE (getangle LP1 "\nAuf welche Seite: ") ) (if (> W PI) (progn (setq WX (- W PI) W1 (/ PI -2)) (if (< WE WX) (setq W1 (/ PI 2)) )
(if (> WE W) (setq W1 (/ PI 2)) ) ) (progn (setq WX (+ W PI) W1 (/ PI 2)) (if (< WE W) (setq W1 (/ PI -2)) ) (if (> WE WX) (setq W1 (/ PI -2)) ) ) )
(setq P1 (polar LP1 (+ W W1) AB) P2 (polar LP2 (+ W W1) AB) ) (KIML P1 P2)(g_un)(prin1))(defun C:g-HM (/ B3 B4 E W)(KIMV)
(setq E (entsel "\nErste Linie w„hlen: ") B4 (osnap (cadr E) "NAE") B3 (osnap (cadr E) "END") E (entsel "\nZweite Linie w„hlen: ")
LP2 (osnap (cadr E) "NAE") LP1 (osnap (cadr E) "END") P1 (inters LP1 LP2 B3 B4 NIL) ) (if (= P1 NIL) (progn
(setq P1 (list (/ (+ (car LP1) (car B3)) 2) (/ (+ (cadr LP1) (cadr B3)) 2)) P2 (polar P1 (angle LP1 LP2) 10) ) ) (progn
(setq W (/ (+ (angle P1 B4) (angle P1 LP2)) 2.0) P2 (polar P1 W 100) ) ) ) (KIML P1 P2)(g_un)(prin1))(defun C:g-HL (/ OS E W)(KIMV)
(setq E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END") LP2 (osnap (cadr E) "MIT") P1 LP2 P2 (polar P1 (+ (angle LP1 LP2) (/ PI 2)) 2.0) )
(KIML P1 P2)(g_un)(prin1))(defun C:g-HT (/ E W)(KIMV) (setq E (entsel "\nKreis oder Bogen w„hlen: ") LP1 (osnap (cadr E) "ZEN")
LP2 (osnap (cadr E) "NAE") LP2 (distance LP1 LP2) W (getangle "\nWinkel angeben: ") ) (setq P1 LP1 P2 (polar P1 W 10) ) (KIML P1 P2)
(setq P1 (polar LP1 (+ (/ PI 2) W) LP2) P2 (polar P1 W 10) ) (KIML P1 P2) (setq P1 (polar LP1 (+ (/ PI -2) W) LP2) P2 (polar P1 W 10) )
(KIML P1 P2)(g_un)(prin1))(defun C:g-HST (/ E M R W)(KIMV) (setq E (entsel "\nKreis oder Bogen w„hlen: ") M (osnap (cadr E) "ZEN")
LP2 (osnap (cadr E) "NAE") R (distance M LP2) E (entsel "\nLinie w„hlen: ") LP1 (osnap (cadr E) "END") LP2 (osnap (cadr E) "NAE")
W (angle LP1 LP2) ) (setq P1 M P2 (polar M (+ (/ PI 2) W) 10) ) (KIML P1 P2) (setq P1 (polar M W R) P2 (polar P1 (+ W (/ PI 2)) 10) ) (KIML P1 P2)
(setq P1 (polar M (+ W PI) R) P2 (polar P1 (+ W (/ PI 2)) 10) ) (KIML P1 P2)(g_un)(prin1))(prompt ".")(defun C:g-KT (/ P1 P2 P3)(KIMV)
(setq P1 (getpoint "\nKreisumfangspunkt w„hlen: ") P2 (getpoint "\nKreisumfangspunkt w„hlen: ") ) (setvar "osmode" 256)
(setq P3 (getpoint "\nTangentenpunkt w„hlen: ")) (command "KREIS" "3P" P1 P2 P3)(g_un)(prin1))(defun C:g-K1 (/ P1 R)(KIMV)
(setq P1 (getpoint "\nMittelpunkt angeben: ")) (setvar "osmode" 128) (setq R (getdist P1 "\nTangentenpunkt w„hlen: ")) (command "KREIS" P1 R)(g_un)
(prin1))(defun C:g-HN (/ E D L WZ W1 PA PB)(KIMV) (setq P1 (getpoint "\nPunkt (durch den Linie gehen soll) w„hlen: ")
E (entsel "\nKreis oder Bogen w„hlen: ") LP1 (osnap (cadr E) "ZEN") F (osnap (cadr E) "NAE") LP2 (distance LP1 F) D (distance LP1 P1)
L (sqrt (- (expt D 2) (expt LP2 2))) WZ (atan (/ LP2 L)) W1 (angle P1 LP1) PA (polar P1 (+ W1 WZ) L) PB (polar P1 (- W1 WZ) L) )
(if (< (distance PA F) (distance PB F)) (setq P2 PA) (setq P2 PB) ) (KIML P1 P2)(g_un)(prin1))(defun C:g-H2 (/ E P1 P2)(KIMV)
(prompt "\nKreis oder Bogen w„hlen: ") (setvar "cmdecho" 1) (setvar "osmode" 256) (command "LINIE" pause pause "") (setvar "cmdecho" 0)
(setq e (entlast) P1 (trans (cdr (assoc 10 (entget e))) 0 1) P2 (trans (cdr (assoc 11 (entget e))) 0 1) ) (entdel e) (KIML P1 P2)(g_un)(prin1))
(defun C:g-K2 (/ P1 P2 P3)(KIMV) (setq P1 (getpoint "\nKreisumfangspunkt w„hlen: ")) (setvar "osmode" 512)
(setq P2 (getpoint "\nTangentenpunkt w„hlen: ") P3 (getpoint "\nTangentenpunkt w„hlen: ")) (command "KREIS" "3P" P1 "TAN" P2 "TAN" P3)(g_un)(prin1)
)(defun C:g-KR (/ P1 P2 R)(KIMV) (setvar "Osmode" 256) (setq P1 (getpoint "\nTangentenpunkt w„hlen: ") P2 (getpoint "\nTangentenpunkt w„hlen: "))
(setvar "OSMODE" 0) (setq R (getdist "\nRadius angeben: ")) (command "KREIS" "TTR" P1 P2 R)(g_un)(prin1))(defun C:g-K3 (/ P1 P2 P3)(KIMV)
(setq P1 (getpoint "\nKreisumfangspunkt w„hlen: ") P2 (getpoint "\nKreisumfangspunkt w„hlen: ") P3 (getpoint "\nKreisumfangspunkt w„hlen: "))
(command "KREIS" "3P" P1 P2 P3)(g_un)(prin1))(prompt ".")(defun C:g-KC (/ P1 R)(KIMV) (setq P1 (getpoint "\nMittelpunkt angeben: ")
R (getdist P1 "\nRadius angeben: ") ) (command "KREIS" P1 R)(g_un)(prin1))(defun C:g-KK (/ E)(KIMV) (setq E (entsel "\nKreis oder Bogen w„hlen: ")
LP1 (osnap (cadr E) "ZEN") F (osnap (cadr E) "NAE") LP2 (getdist LP1 "\nRadius angeben: ") ) (command "KREIS" LP1 LP2)(g_un)(prin1))
(defun C:g-KP (/ P1 P2)(KIMV) (setq P1 (getpoint "\nKreisumfangspunkt w„hlen: ") P2 (getpoint P1 "\nKreisumfangspunkt w„hlen: "))
(command "KREIS" "2P" P1 P2)(g_un)(prin1))(defun C:g-K3T (/ P1 P2 P3)(KIMV) (setvar "osmode" 256) (setq P1 (getpoint "\nTangentenpunkt w„hlen: ")
P2 (getpoint "\nTangentenpunkt w„hlen: ") P3 (getpoint "\nTangentenpunkt w„hlen: ")) (command "KREIS" "3P" P1 P2 P3)(g_un)(prin1))(princ)