Nazwa forum

Opis forum


#1 2009-12-02 10:24:37

pitrzak

Użytkownik

Zarejestrowany: 2009-11-04
Posty: 59
Punktów :   

Programy do menu

OBLICZENIA (znane jako dupa.lsp):

Kod:

(defun jeden ()
  (princ "\nJestesmy w procedurze dodawania:");
    (setq
        x1 (getint "\nPodaj liczbe : ")
        x2 (getint "\nPodaj liczbe2 : ")
      d(+ x1 x2)
    );

  (princ
    (rtos d 2 0)
   );
);
  
(defun dwa ()
  (princ "\nJestesmy w procedurze odejmowania:");
    (setq
        x1 (getint "\nPodaj liczbe : ")
        x2 (getint "\nPodaj liczbe2 : ")
      d(- x1 x2)
    );
    
  (princ
    (rtos d 2 0)
    );
);

(defun trzy ()
  (princ "\nfunkcja zlozona:");
  
  (setq
        x1 (getint "\nPodaj liczbe : ")

    z(* 2 x1)
    y(sqrt z)

   );
  (princ "\nwynik mnozenia: ");
  (princ
    (rtos z 2 5)
   );
   
   ;(setq
    ; );
  (princ "\nwynik pierwiastkowania: ");
  (princ 
    (rtos y 2 5)
  );
);

(defun prog()
  (setq
    y (getint "podaj 1-dod 2-odejm  3-funkcja zlozona: ")
    ;x1 (getint "\nPodaj liczbe : ")
    ;x2 (getint "\nPodaj liczbe2 : ")
  );setq
  
(if (= y 1)(jeden))
(if (= y 2)(dwa))
(if (= y 3)(trzy))

  (setq q (getint "\n\n Jeszcze raz? [1 - TAK] / [2 - NIE]:"));
    (if(= q 1)(prog))
);
(prog)

DELTA:

Kod:

  (defun zero();
    (setq
    minusb(* b -1);
    2a(* a a);
    x (/ minusb 2a);
    );
    (princ "\nDelta wynosi: ");
    (princ (rtos d 2 5));
    (princ "\nRozwiązanie równania: ");
    (princ (rtos x 2 5));
  )

  (defun ujemna();
    (princ "\nDelta wynosi: ");
    (princ (rtos d 2 5));
    (princ "\nRównanie nie posiada rozwiązań.");
  )

  (defun dodatnia();
    (setq
    pierwiastekd(sqrt d);
    minusb(* b -1);
    2a(* a a);
    licznik1(- minusb pierwiastekd);
    x1 (/ licznik1 2a);
    
    licznik2(+ minusb pierwiastekd);
    x2 (/ licznik2 2a);
    );
    (princ "\nDelta wynosi: ");
    (princ (rtos d 2 5));
    (princ "\nPierwiastek 1: ");
    (princ (rtos x1 2 5));
    (princ "\nPierwiastek 2: ");
    (princ (rtos x2 2 5));
  )

(defun program_pierwiastki();
  (setq
        a (getint "\nPodaj liczbe a: ")
        b (getint "\nPodaj liczbe b: ")
        c (getint "\nPodaj liczbe c: ")
    
    ac(* a c);
    4ac(* ac 4);
    b2(* b b);
    d(- b2 4ac);  
   );
   (if (= d 0)(zero))
   (if (<= d 0)(ujemna))
   (if (> d 0)(dodatnia))
 
 (setq q (getint "\n\n Jeszcze raz? [1 - TAK] / [2 - NIE]:"));
    (if(= q 1)(program_pierwiastki))
);
(program_pierwiastki)

SWORZEN (od Gana):

Kod:

(defun warstwy ()
(command "_layer" "_new" "0" "_new" "TL1" "_new" "TL2" "_new" "TL3" "_new" "TL4" "_new" "TL5" "")
(command "_layer" "_ltype" "continuous" "0" "")
(command "_layer" "_ltype" "center" "TL1" "")
(command "_layer" "_ltype" "continuous" "TL2" "")
(command "_layer" "_ltype" "continuous" "TL3" "")
(command "_layer" "_ltype" "dashed" "TL4" "")
(command "_layer" "_ltype" "continuous" "TL5" "")
(command "_layer" "_color" "_blue" "TL1" "")
(command "_layer" "_color" "_red" "TL2" "")
(command "_layer" "_color" "_green" "TL3" "")
(command "_layer" "_color" "_yellow" "TL4" "")
(command "_layer" "_color" "_green" "TL5" "")
             
(defun sworzen ()
(setq d1 40)
(setq d2 60)
(setq d3 16)
(setq l1 90)
(setq l2 65)
(setq l3 25)
(setq n 5)
(setq p0 (getpoint "\nZazanaczyć pierwszy punkt:"))
(setq p1 (list (car p0) (+ (cadr p0) (- (/ d2 2) n))))
(setq p2 (list (+ (car p1) n) (+ (cadr p1) n)))
(setq p3 (list (+ (car p2) (- l1 (+ l2 n))) (cadr p2)))
(setq p4 (list (car p3) (- (cadr p3) (- (/ d2 2) (/ d1 2)))))
(setq p5 (list (+ (car p4) (- l2 n)) (cadr p4)))
(setq p6 (list (+ (car p5) n) (- (cadr p5) n)))
(setq p7 (list (car p6) (cadr p0)))
(setq p8 (list (car p7) (- (cadr p7) (- (/ d1 2) n))))
(setq p9 (list (- (car p8) n) (- (cadr p8) n)))
(setq p10 (list (car p4) (cadr p9)))
(setq p11 (list (car p10) (- (cadr p10) (- (/ d2 2) (/ d1 2)))))
(setq p12 (list (car p2) (cadr p11)))
(setq p13 (list (car p0) (+ (cadr p12) n)))
(setq p14 (list (- (car p7) l3) (cadr p7)))

(setq p15 (list (- (car p0) 5) (cadr p0)))
(setq p16 (list (+ (car p7) 5) (cadr p7)))
(setq p17 (list (car p14) (- (cadr p14) (+ (/ d3 2) 5))))
(setq p18 (list (car p14) (+ (cadr p14) (+ (/ d3 2) 5))))

(setq p30 (list (+ (car p7) 11) (cadr p7)))
(setq p31 (list (- (car p0) 11) (cadr p0)))
(setq p32 (list (car p9) (- (cadr p0) 48)))
(setq p33 (list (car p9) (- (cadr p0) 55)))
(setq p34 (list (car p9) (- (cadr p0) 62)))
(setq p35 (list (car p9) (- (cadr p0) 41)))
(setq p36 (list (car p12) (- (cadr p12) 11)))
(setq p37 (list (- (car p14) (/ d3 2)) (cadr p14)))
(setq p38 (list (+ (car p14) (/ d3 2)) (cadr p14)))

(setq pk1 (list (car p3) (cadr p3)))

;gabaryty
(command "_layer" "_s" "0" "")
(command "_pline" p11 p12  p2 pk1 "_cl")
(command "_line" p4 p5 p6 p8 p9 p10 "" )
(command "_circle"  p14 "_d" d3 )
(command "_line" p12 p13 p1 p2 "")
(command "_line" p5 p9 "" )

;osie
(command "_layer" "_s" "TL1" "")
(command "_line" p15 p16 "")
(command "_line" p17 p18 "")

;wymiary
(command "_layer" "_s" "TL2" "")
(command "_.DIM" "_VER" p9 p5 p30 (strcat "%%c"(rtos d1 2 2)) "_exit")
(command "_.DIM" "_VER" p12 p2 p31 (strcat "%%c"(rtos d2 2 2)) "_exit")
(command "_.DIM" "_HOR" p8 p14 p32 (rtos l3 2 2) "_exit")
(command "_.DIM" "_HOR" p8 p11 p33 (rtos l2 2 2) "_exit")
(command "_.DIM" "_HOR" p8 p13 p34 (rtos l1 2 2) "_exit")
(command "_.DIM" "_HOR" p8 p9 p35 (strcat (rtos n 2 2) "x45%%d") "_exit")
(command "_.DIM" "_HOR" p13 p12 p36 (strcat (rtos n 2 2) "x45%%d") "_exit")
(command "_.DIM" "_HOR" p38 p37 p14 (strcat "%%c"(rtos d3 2 2)) "_exit")

;kreskowanie
(command "_layer" "_s" "TL3" "")
(command "_hatch" "_u" 45 3 "_n" pk1 "")

)
)
(warstwy)
(sworzen)

PLIK MENU.MNU (zmiencie sobie sciezke do poszczegolnych plikow)

Kod:

***POP5
[Programy]
[->Zajecia 1]
[<-Obliczenia]^C^C(load "g:/autolisp/zadania/obliczenia.lsp")
[--]
[->Zajecia 2]
[<-Delta]^C^C(load "g:/autolisp/zadania/delta.lsp")
[--]
[->Zajecia 3]
[<-Sworzen]^C^C(load "g:/autolisp/zadania/sworzen.lsp")
[--]
[->Zajecia 4]
[<-Frezowanie ukosne]^C^C(load "g:/autolisp/zadania/karta_frezowanie_ukosne.lsp")

Karty technologicznej nie daje bo mi sie wysypuje.

Ostatnio edytowany przez pitrzak (2009-12-02 22:53:19)

Offline

 

Stopka forum

RSS
Powered by PunBB
© Copyright 2002–2008 PunBB
Polityka cookies - Wersja Lo-Fi


Darmowe Forum | Ciekawe Fora | Darmowe Fora
www.kutnowskagruparajdowa.pun.pl www.walczmyrazem.pun.pl www.biezuniacy.pun.pl www.16jdshpiorun.pun.pl www.winxclub.pun.pl