Prikazi cijelu temu 07.03.2011 13:56
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Vrata od regala
Ova lisp procedura iscrtava nacrt vrata od regala i proporcionalno od ivica saru koja skoro uvijek ima na vratima.
Ako radite sa drvetom obavezno isprobajte.
PreuzmiIzvorni kôd (Lisp):
  1. ;*Sara
  2. ;Crtanje sare na vratima
  3. (command "ucs" "w")
  4. (setq pt1 (getpoint "Po
  5. etak crtanja Klik: "))
  6. ;(setq pt2 (getpoint pt1 "Kraj linije: "))
  7. ;(setq pt3 (getpoint pt2 "Kraj linije: "))
  8. (setq Duz (getreal "Dužina vrata: "))
  9. (setq Sir (getreal "Å irina vrata: "))
  10. (setq Rast (getreal  "Razmak: "))
  11.  
  12. (setq pt2 (list (+(car pt1) Duz) (cadr pt1)))
  13. (setq pt3 (list (car pt2) (+(cadr pt2) Sir)))
  14. (setq pt4 (list (car pt1) (cadr pt3)))
  15. (setq pt5 (list(+(car pt1) Rast) (+(cadr pt1) Rast)))
  16. (setq pt6 (list(-(car pt2) Rast) (+(cadr pt2) Rast)))
  17. (setq pt7 (list(-(car pt3) Rast) (-(cadr pt3) Rast)))
  18. (setq pt8 (list(+(car pt4) Rast) (-(cadr pt4) Rast)))
  19.  
  20. (setq konst (/(distance pt6 pt7) 332.029))
  21. (setq razmak1 (* konst 45.0218))
  22.  
  23. (setq pt9 (list(+(car pt5) razmak1) (cadr pt5)))
  24. (setq pt10 (list (car pt9) (cadr pt8)))
  25. (setq razmak1 (/(distance pt6 pt7) 2))
  26. (setq pt11 (list (car pt5) (-(cadr pt8) razmak1)))
  27. (setq razmak1 (* konst 152.77))
  28. (setq razmak2 (* konst 5.75))
  29. (setq pt12 (list(-(car pt10) razmak1) (-(cadr pt10) razmak2)))
  30. (setq pt13 (list(-(car pt9) razmak1) (+(cadr pt9) razmak2)))
  31. (setq razmak1 (* konst 21.42))
  32. (setq razmak2 (* konst 83.94))
  33. (setq pt14 (list(-(car pt10) razmak1) (-(cadr pt10) razmak2)))
  34. (setq pt15 (list(-(car pt9) razmak1) (+(cadr pt9) razmak2)))
  35. (setq razmak1 (* konst 147.0182))
  36. (setq pt16 (list(+(car pt11) razmak1) (cadr pt11)))
  37. (setq razmak1 (* konst 152.77))
  38. (setq pt17 (polar pt12 (angle pt12 pt6) razmak1))
  39. (setq pt18 (polar pt13 (angle pt13 pt7) razmak1))
  40.  
  41. (setq OSM (getvar "osmode"))
  42. (command "osmode" "0")
  43. (command "Layer" "s" "0" "" )
  44. (command "PLINE" pt1  pt2 pt3 pt4 pt1  "")
  45. (command "Layer" "s" "Sara" "")
  46. (command "PLINE" pt9  pt6 pt7 pt10 "A" "S" pt17 pt14 pt11 pt15 pt18 pt9 "")
  47.  
  48. (command "osmode" OSM)

Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.